Theory Floyd_Warshall
theory Floyd_Warshall
imports Main
begin
chapter ‹Floyd-Warshall Algorithm for the All-Pairs Shortest Paths Problem›
subsubsection ‹Auxiliary›
lemma distinct_list_single_elem_decomp: "{xs. set xs ⊆ {0} ∧ distinct xs} = {[], [0]}"
proof (standard, goal_cases)
case 1
{ fix xs :: "'a list" assume xs: "xs ∈ {xs. set xs ⊆ {0} ∧ distinct xs}"
have "xs ∈ {[], [0]}"
proof (cases xs)
case (Cons y ys)
hence y: "y = 0" using xs by auto
with Cons xs have "ys = []" by (cases ys, auto)
thus ?thesis using y Cons by simp
qed simp
}
thus ?case by blast
qed simp
section ‹Cycles in Lists›
abbreviation "cnt x xs ≡ length (filter (λy. x = y) xs)"
fun remove_cycles :: "'a list ⇒ 'a ⇒ 'a list ⇒ 'a list"
where
"remove_cycles [] _ acc = rev acc" |
"remove_cycles (x#xs) y acc =
(if x = y then remove_cycles xs y [x] else remove_cycles xs y (x#acc))"
lemma cnt_rev: "cnt x (rev xs) = cnt x xs" by (metis length_rev rev_filter)
value "as @ [x] @ bs @ [x] @ cs @ [x] @ ds"
lemma remove_cycles_removes: "cnt x (remove_cycles xs x ys) ≤ max 1 (cnt x ys)"
proof (induction xs arbitrary: ys)
case Nil thus ?case
by (simp, cases "x ∈ set ys", (auto simp: cnt_rev[of x ys]))
next
case (Cons y xs)
thus ?case
proof (cases "x = y")
case True
thus ?thesis using Cons[of "[y]"] True by auto
next
case False
thus ?thesis using Cons[of "y # ys"] by auto
qed
qed
lemma remove_cycles_id: "x ∉ set xs ⟹ remove_cycles xs x ys = rev ys @ xs"
by (induction xs arbitrary: ys) auto
lemma remove_cycles_cnt_id:
"x ≠ y ⟹ cnt y (remove_cycles xs x ys) ≤ cnt y ys + cnt y xs"
proof (induction xs arbitrary: ys x)
case Nil thus ?case by (simp add: cnt_rev)
next
case (Cons z xs)
thus ?case
proof (cases "x = z")
case True thus ?thesis using Cons.IH[of z "[z]"] Cons.prems by auto
next
case False
thus ?thesis using Cons.IH[of x "z # ys"] Cons.prems False by auto
qed
qed
lemma remove_cycles_ends_cycle: "remove_cycles xs x ys ≠ rev ys @ xs ⟹ x ∈ set xs"
using remove_cycles_id by fastforce
lemma remove_cycles_begins_with: "x ∈ set xs ⟹ ∃ zs. remove_cycles xs x ys = x # zs ∧ x ∉ set zs"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons y xs)
thus ?case
proof (cases "x = y")
case True thus ?thesis
proof (cases "x ∈ set xs", goal_cases)
case 1 with Cons show ?case by auto
next
case 2 with remove_cycles_id[of x xs "[y]"] show ?case by auto
qed
next
case False
with Cons show ?thesis by auto
qed
qed
lemma remove_cycles_self:
"x ∈ set xs ⟹ remove_cycles (remove_cycles xs x ys) x zs = remove_cycles xs x ys"
proof -
assume x:"x ∈ set xs"
then obtain ws where ws: "remove_cycles xs x ys = x # ws" "x ∉ set ws"
using remove_cycles_begins_with[OF x, of ys] by blast
from remove_cycles_id[OF this(2)] have "remove_cycles ws x [x] = x # ws" by auto
with ws(1) show "remove_cycles (remove_cycles xs x ys) x zs = remove_cycles xs x ys" by simp
qed
lemma remove_cycles_one: "remove_cycles (as @ x # xs) x ys = remove_cycles (x#xs) x ys"
by (induction as arbitrary: ys) auto
lemma remove_cycles_cycles:
"x ∈ set xs ⟹ ∃ xxs as. as @ concat (map (λ xs. x # xs) xxs) @ remove_cycles xs x ys = xs ∧ x ∉ set as"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons y xs)
thus ?case
proof (cases "x = y")
case True thus ?thesis
proof (cases "x ∈ set xs", goal_cases)
case 1
then obtain as xxs where "as @ concat (map (λxs. y#xs) xxs) @ remove_cycles xs y [y] = xs"
using Cons.IH[of "[y]"] by auto
hence "[] @ concat (map (λxs. x#xs) (as#xxs)) @ remove_cycles (y#xs) x ys = y # xs"
by (simp add: ‹x = y›)
thus ?thesis by fastforce
next
case 2
hence "remove_cycles (y # xs) x ys = y # xs" using remove_cycles_id[of x xs "[y]"] by auto
hence "[] @ concat (map (λxs. x # xs) []) @ remove_cycles (y#xs) x ys = y # xs" by auto
thus ?thesis by fastforce
qed
next
case False
then obtain as xxs where as:
"as @ concat (map (λxs. x # xs) xxs) @ remove_cycles xs x (y#ys) = xs" "x ∉ set as"
using Cons.IH[of "y # ys"] Cons.prems by auto
hence "(y # as) @ concat (map (λxs. x # xs) xxs) @ remove_cycles (y#xs) x ys = y # xs"
using ‹x ≠ y› by auto
thus ?thesis using as(2) ‹x ≠ y› by fastforce
qed
qed
fun start_remove :: "'a list ⇒ 'a ⇒ 'a list ⇒ 'a list"
where
"start_remove [] _ acc = rev acc" |
"start_remove (x#xs) y acc =
(if x = y then rev acc @ remove_cycles xs y [y] else start_remove xs y (x # acc))"
lemma start_remove_decomp:
"x ∈ set xs ⟹ ∃ as bs. xs = as @ x # bs ∧ start_remove xs x ys = rev ys @ as @ remove_cycles bs x [x]"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons y xs)
thus ?case
proof (auto, goal_cases)
case 1
from 1(1)[of "y # ys"]
obtain as bs where
"xs = as @ x # bs" "start_remove xs x (y # ys) = rev (y # ys) @ as @ remove_cycles bs x [x]"
by blast
hence "y # xs = (y # as) @ x # bs"
"start_remove xs x (y # ys) = rev ys @ (y # as) @ remove_cycles bs x [x]" by simp+
thus ?case by blast
qed
qed
lemma start_remove_removes: "cnt x (start_remove xs x ys) ≤ Suc (cnt x ys)"
proof (induction xs arbitrary: ys)
case Nil thus ?case using cnt_rev[of x ys] by auto
next
case (Cons y xs)
thus ?case
proof (cases "x = y")
case True
thus ?thesis using remove_cycles_removes[of y xs "[y]"] cnt_rev[of y ys] by auto
next
case False
thus ?thesis using Cons[of "y # ys"] by auto
qed
qed
lemma start_remove_id[simp]: "x ∉ set xs ⟹ start_remove xs x ys = rev ys @ xs"
by (induction xs arbitrary: ys) auto
lemma start_remove_cnt_id:
"x ≠ y ⟹ cnt y (start_remove xs x ys) ≤ cnt y ys + cnt y xs"
proof (induction xs arbitrary: ys)
case Nil thus ?case by (simp add: cnt_rev)
next
case (Cons z xs)
thus ?case
proof (cases "x = z", goal_cases)
case 1 thus ?case using remove_cycles_cnt_id[of x y xs "[x]"] by (simp add: cnt_rev)
next
case 2 from this(1)[of "(z # ys)"] this(2,3) show ?case by auto
qed
qed
fun remove_all_cycles :: "'a list ⇒ 'a list ⇒ 'a list"
where
"remove_all_cycles [] xs = xs" |
"remove_all_cycles (x # xs) ys = remove_all_cycles xs (start_remove ys x [])"
lemma cnt_remove_all_mono:"cnt y (remove_all_cycles xs ys) ≤ max 1 (cnt y ys)"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons x xs)
thus ?case
proof (cases "x = y")
case True thus ?thesis using start_remove_removes[of y ys "[]"] Cons[of "start_remove ys y []"]
by auto
next
case False
hence "cnt y (start_remove ys x []) ≤ cnt y ys"
using start_remove_cnt_id[of x y ys "[]"] by auto
thus ?thesis using Cons[of "start_remove ys x []"] by auto
qed
qed
lemma cnt_remove_all_cycles: "x ∈ set xs ⟹ cnt x (remove_all_cycles xs ys) ≤ 1"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons y xs)
thus ?case
using start_remove_removes[of x ys "[]"] cnt_remove_all_mono[of y xs "start_remove ys y []"]
by auto
qed
lemma cnt_mono:
"cnt a (b # xs) ≤ cnt a (b # c # xs)"
by (induction xs) auto
lemma cnt_distinct_intro: "∀ x ∈ set xs. cnt x xs ≤ 1 ⟹ distinct xs"
proof (induction xs)
case Nil thus ?case by auto
next
case (Cons x xs)
from this(2) have "∀ x ∈ set xs. cnt x xs ≤ 1"
by (metis filter.simps(2) impossible_Cons linorder_class.linear list.set_intros(2)
preorder_class.order_trans)
with Cons.IH have "distinct xs" by auto
moreover have "x ∉ set xs" using Cons.prems
proof (induction xs)
case Nil then show ?case by auto
next
case (Cons a xs)
from this(2) have "∀xa∈set (x # xs). cnt xa (x # a # xs) ≤ 1"
by auto
then have *: "∀xa∈set (x # xs). cnt xa (x # xs) ≤ 1"
proof (safe, goal_cases)
case (1 b)
then have "cnt b (x # a # xs) ≤ 1" by auto
with cnt_mono[of b x xs a] show ?case by fastforce
qed
with Cons(1) have "x ∉ set xs" by auto
moreover have "x ≠ a"
by (metis (full_types) Cons.prems One_nat_def * empty_iff filter.simps(2) impossible_Cons
le_0_eq le_Suc_eq length_0_conv list.set(1) list.set_intros(1))
ultimately show ?case by auto
qed
ultimately show ?case by auto
qed
lemma remove_cycles_subs:
"set (remove_cycles xs x ys) ⊆ set xs ∪ set ys"
by (induction xs arbitrary: ys; auto; fastforce)
lemma start_remove_subs:
"set (start_remove xs x ys) ⊆ set xs ∪ set ys"
using remove_cycles_subs by (induction xs arbitrary: ys; auto; fastforce)
lemma remove_all_cycles_subs:
"set (remove_all_cycles xs ys) ⊆ set ys"
using start_remove_subs by (induction xs arbitrary: ys, auto) (fastforce+)
lemma remove_all_cycles_distinct: "set ys ⊆ set xs ⟹ distinct (remove_all_cycles xs ys)"
proof -
assume "set ys ⊆ set xs"
hence "∀ x ∈ set ys. cnt x (remove_all_cycles xs ys) ≤ 1" using cnt_remove_all_cycles by fastforce
hence "∀ x ∈ set (remove_all_cycles xs ys). cnt x (remove_all_cycles xs ys) ≤ 1"
using remove_all_cycles_subs by fastforce
thus "distinct (remove_all_cycles xs ys)" using cnt_distinct_intro by auto
qed
lemma distinct_remove_cycles_inv: "distinct (xs @ ys) ⟹ distinct (remove_cycles xs x ys)"
proof (induction xs arbitrary: ys)
case Nil thus ?case by auto
next
case (Cons y xs)
thus ?case by auto
qed
definition "remove_all x xs = (if x ∈ set xs then tl (remove_cycles xs x []) else xs)"
definition "remove_all_rev x xs = (if x ∈ set xs then rev (tl (remove_cycles (rev xs) x [])) else xs)"
lemma remove_all_distinct:
"distinct xs ⟹ distinct (x # remove_all x xs)"
proof (cases "x ∈ set xs", goal_cases)
case 1
from remove_cycles_begins_with[OF 1(2), of "[]"] obtain zs
where "remove_cycles xs x [] = x # zs" "x ∉ set zs" by auto
thus ?thesis using 1(1) distinct_remove_cycles_inv[of "xs" "[]" x] by (simp add: remove_all_def)
next
case 2 thus ?thesis by (simp add: remove_all_def)
qed
lemma remove_all_removes:
"x ∉ set (remove_all x xs)"
by (metis list.sel(3) remove_all_def remove_cycles_begins_with)
lemma remove_all_subs:
"set (remove_all x xs) ⊆ set xs"
using remove_cycles_subs remove_all_def
by (metis (no_types, lifting) append_Nil2 list.sel(2) list.set_sel(2) set_append subsetCE subsetI)
lemma remove_all_rev_distinct: "distinct xs ⟹ distinct (x # remove_all_rev x xs)"
proof (cases "x ∈ set xs", goal_cases)
case 1
then have "x ∈ set (rev xs)" by auto
from remove_cycles_begins_with[OF this, of "[]"] obtain zs
where "remove_cycles (rev xs) x [] = x # zs" "x ∉ set zs" by auto
thus ?thesis using 1(1) distinct_remove_cycles_inv[of "rev xs" "[]" x] by (simp add: remove_all_rev_def)
next
case 2 thus ?thesis by (simp add: remove_all_rev_def)
qed
lemma remove_all_rev_removes: "x ∉ set (remove_all_rev x xs)"
by (metis remove_all_def remove_all_removes remove_all_rev_def set_rev)
lemma remove_all_rev_subs: "set (remove_all_rev x xs) ⊆ set xs"
by (metis remove_all_def remove_all_subs set_rev remove_all_rev_def)
abbreviation "rem_cycles i j xs ≡ remove_all i (remove_all_rev j (remove_all_cycles xs xs))"
lemma rem_cycles_distinct': "i ≠ j ⟹ distinct (i # j # rem_cycles i j xs)"
proof -
assume "i ≠ j"
have "distinct (remove_all_cycles xs xs)" by (simp add: remove_all_cycles_distinct)
from remove_all_rev_distinct[OF this] have
"distinct (remove_all_rev j (remove_all_cycles xs xs))"
by simp
from remove_all_distinct[OF this] have "distinct (i # rem_cycles i j xs)" by simp
moreover have
"j ∉ set (rem_cycles i j xs)"
using remove_all_subs remove_all_rev_removes remove_all_removes by fastforce
ultimately show ?thesis by (simp add: ‹i ≠ j›)
qed
lemma rem_cycles_removes_last: "j ∉ set (rem_cycles i j xs)"
by (meson remove_all_rev_removes remove_all_subs rev_subsetD)
lemma rem_cycles_distinct: "distinct (rem_cycles i j xs)"
by (meson distinct.simps(2) order_refl remove_all_cycles_distinct
remove_all_distinct remove_all_rev_distinct)
lemma rem_cycles_subs: "set (rem_cycles i j xs) ⊆ set xs"
by (meson order_trans remove_all_cycles_subs remove_all_subs remove_all_rev_subs)
section ‹Definition of the Algorithm›
text ‹
We formalize the Floyd-Warshall algorithm on a linearly ordered abelian semigroup.
However, we would not need an ‹abelian› monoid if we had the right type class.
›
class linordered_ab_monoid_add = linordered_ab_semigroup_add +
fixes neutral :: 'a ("𝟭")
assumes neutl[simp]: "𝟭 + x = x"
assumes neutr[simp]: "x + 𝟭 = x"
begin
lemmas assoc = add.assoc
type_synonym 'c mat = "nat ⇒ nat ⇒ 'c"
definition (in -) upd :: "'c mat ⇒ nat ⇒ nat ⇒ 'c ⇒ 'c mat"
where
"upd m x y v = m (x := (m x) (y := v))"
definition fw_upd :: "'a mat ⇒ nat ⇒ nat ⇒ nat ⇒ 'a mat" where
"fw_upd m k i j ≡ upd m i j (min (m i j) (m i k + m k j))"
lemma fw_upd_mono:
"fw_upd m k i j i' j' ≤ m i' j'"
by (cases "i = i'", cases "j = j'") (auto simp: fw_upd_def upd_def)
fun fw :: "'a mat ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ 'a mat" where
"fw m n 0 0 0 = fw_upd m 0 0 0" |
"fw m n (Suc k) 0 0 = fw_upd (fw m n k n n) (Suc k) 0 0" |
"fw m n k (Suc i) 0 = fw_upd (fw m n k i n) k (Suc i) 0" |
"fw m n k i (Suc j) = fw_upd (fw m n k i j) k i (Suc j)"
lemma fw_invariant_aux_1:
"j'' ≤ j ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n ⟹ fw m n k i j i' j' ≤ fw m n k i j'' i' j'"
proof (induction j)
case 0 thus ?case by simp
next
case (Suc j) thus ?case
proof (cases "j'' = Suc j")
case True thus ?thesis by simp
next
case False
have "fw_upd (fw m n k i j) k i (Suc j) i' j' ≤ fw m n k i j i' j'" by (simp add: fw_upd_mono)
thus ?thesis using Suc False by simp
qed
qed
lemma fw_invariant_aux_2:
"i ≤ n ⟹ j ≤ n ⟹ k ≤ n ⟹ i'' ≤ i ⟹ j'' ≤ j
⟹ fw m n k i j i' j' ≤ fw m n k i'' j'' i' j'"
proof (induction i)
case 0 thus ?case using fw_invariant_aux_1 by auto
next
case (Suc i) thus ?case
proof (cases "i'' = Suc i")
case True thus ?thesis using Suc fw_invariant_aux_1 by simp
next
case False
have "fw m n k (Suc i) j i' j' ≤ fw m n k (Suc i) 0 i' j'"
using fw_invariant_aux_1[of 0 j "Suc i" n k] Suc(2-) by simp
also have "… ≤ fw m n k i n i' j'" by (simp add: fw_upd_mono)
also have "… ≤ fw m n k i j i' j'" using fw_invariant_aux_1[of j n i n k] False Suc by simp
also have "… ≤ fw m n k i'' j'' i' j'" using Suc False by simp
finally show ?thesis by simp
qed
qed
lemma fw_invariant:
"k' ≤ k ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n ⟹ j'' ≤ j ⟹ i'' ≤ i
⟹ fw m n k i j i' j' ≤ fw m n k' i'' j'' i' j'"
proof (induction k)
case 0 thus ?case using fw_invariant_aux_2 by auto
next
case (Suc k) thus ?case
proof (cases "k' = Suc k")
case True thus ?thesis using Suc fw_invariant_aux_2 by simp
next
case False
have "fw m n (Suc k) i j i' j' ≤ fw m n (Suc k) 0 0 i' j'"
using fw_invariant_aux_2[of i n j "Suc k" 0 0] Suc(2-) by simp
also have "… ≤ fw m n k n n i' j'" by (simp add: fw_upd_mono)
also have "… ≤ fw m n k i j i' j'" using fw_invariant_aux_2[of n n n k] False Suc by simp
also have "… ≤ fw m n k' i'' j'' i' j'" using Suc False by simp
finally show ?thesis by simp
qed
qed
lemma single_row_inv:
"j' < j ⟹ j ≤ n ⟹ i' ≤ n ⟹ fw m n k i' j i' j' = fw m n k i' j' i' j'"
proof (induction j)
case 0 thus ?case by simp
next
case (Suc j) thus ?case by (cases "j' = j") (simp add: fw_upd_def upd_def)+
qed
lemma single_iteration_inv':
"i' < i ⟹ j' ≤ n ⟹ j ≤ n ⟹ i ≤ n ⟹ fw m n k i j i' j' = fw m n k i' j' i' j'"
proof (induction i arbitrary: j)
case 0 thus ?case by simp
next
case (Suc i) thus ?case
proof (induction j)
case 0 thus ?case
proof (cases "i = i'", goal_cases)
case 2 thus ?case by (simp add: fw_upd_def upd_def)
next
case 1 thus ?case using single_row_inv[of j' n n i' m k]
by (cases "j' = n") (fastforce simp add: fw_upd_def upd_def)+
qed
next
case (Suc j) thus ?case by (simp add: fw_upd_def upd_def)
qed
qed
lemma single_iteration_inv:
"i' ≤ i ⟹ j' ≤ j ⟹ i ≤ n ⟹ j ≤ n⟹ fw m n k i j i' j' = fw m n k i' j' i' j'"
proof (induction i arbitrary: j)
case 0 thus ?case
proof (induction j)
case 0 thus ?case by simp
next
case (Suc j) thus ?case using 0 by (cases "j' = Suc j") (simp add: fw_upd_def upd_def)+
qed
next
case (Suc i) thus ?case
proof (induction j)
case 0 thus ?case by (cases "i' = Suc i") (simp add: fw_upd_def upd_def)+
next
case (Suc j) thus ?case
proof (cases "i' = Suc i", goal_cases)
case 1 thus ?case
proof (cases "j' = Suc j", goal_cases)
case 1 thus ?case by simp
next
case 2 thus ?case by (simp add: fw_upd_def upd_def)
qed
next
case 2 thus ?case
proof (cases "j' = Suc j", goal_cases)
case 1 thus ?case using single_iteration_inv'[of i' "Suc i" j' n "Suc j" m k] by simp
next
case 2 thus ?case by (simp add: fw_upd_def upd_def)
qed
qed
qed
qed
lemma fw_innermost_id:
"i ≤ n ⟹ j ≤ n ⟹ j' ≤ n ⟹ i' < i ⟹ fw m n 0 i' j' i j = m i j"
proof (induction i' arbitrary: j')
case 0 thus ?case
proof (induction j')
case 0 thus ?case by (simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
qed
next
case (Suc i') thus ?case
proof (induction j')
case 0 thus ?case by (auto simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
qed
qed
lemma fw_middle_id:
"i ≤ n ⟹ j ≤ n ⟹ j' < j ⟹ i' ≤ i ⟹ fw m n 0 i' j' i j = m i j"
proof (induction i' arbitrary: j')
case 0 thus ?case
proof (induction j')
case 0 thus ?case by (simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
qed
next
case (Suc i') thus ?case
proof (induction j')
case 0 thus ?case using fw_innermost_id by (auto simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
qed
qed
lemma fw_outermost_mono:
"i ≤ n ⟹ j ≤ n ⟹ fw m n 0 i j i j ≤ m i j"
proof (cases j)
case 0
assume "i ≤ n"
thus ?thesis
proof (cases i)
case 0 thus ?thesis using ‹j = 0› by (simp add: fw_upd_def upd_def)
next
case (Suc i')
hence "fw m n 0 i' n (Suc i') 0 = m (Suc i') 0" using fw_innermost_id[of "Suc i'" n 0 n i' m]
using ‹i ≤ n› by simp
thus ?thesis using ‹j = 0› Suc by (simp add: fw_upd_def upd_def)
qed
next
case (Suc j')
assume "i ≤ n" "j ≤ n"
hence "fw m n 0 i j' i (Suc j') = m i (Suc j')"
using fw_middle_id[of i n "Suc j'" j' i m] Suc by simp
thus ?thesis using Suc by (simp add: fw_upd_def upd_def)
qed
lemma Suc_innermost_id1:
"i ≤ n ⟹ j ≤ n ⟹ j' ≤ n ⟹ i' < i ⟹ fw m n (Suc k) i' j' i j = fw m n k i j i j"
proof (induction i' arbitrary: j')
case 0 thus ?case
proof (induction j')
case 0
hence "fw m n k n n i j = fw m n k i j i j" using single_iteration_inv[of i n j n n m k] by simp
thus ?case using 0 by (simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
qed
next
case (Suc i') thus ?case
proof (induction j')
case 0 thus ?case by (auto simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
qed
qed
lemma Suc_innermost_id2:
"i ≤ n ⟹ j ≤ n ⟹ j' < j ⟹ i' ≤ i ⟹ fw m n (Suc k) i' j' i j = fw m n k i j i j"
proof (induction i' arbitrary: j')
case 0
hence "fw m n k n n i j = fw m n k i j i j" using single_iteration_inv[of i n j n n m k] by simp
with 0 show ?case
proof (induction j')
case 0
thus ?case by (auto simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp: fw_upd_def upd_def)
qed
next
case (Suc i') thus ?case
proof (induction j')
case 0 thus ?case using Suc_innermost_id1 by (auto simp add: fw_upd_def upd_def)
next
case (Suc j') thus ?case by (auto simp add: fw_upd_def upd_def)
qed
qed
lemma Suc_innermost_id1':
"i ≤ n ⟹ j ≤ n ⟹ j' ≤ n ⟹ i' < i ⟹ fw m n (Suc k) i' j' i j = fw m n k n n i j"
proof goal_cases
case 1
hence "fw m n (Suc k) i' j' i j = fw m n k i j i j" using Suc_innermost_id1 by simp
thus ?thesis using 1 single_iteration_inv[of i n] by simp
qed
lemma Suc_innermost_id2':
"i ≤ n ⟹ j ≤ n ⟹ j' < j ⟹ i' ≤ i ⟹ fw m n (Suc k) i' j' i j = fw m n k n n i j"
proof goal_cases
case 1
hence "fw m n (Suc k) i' j' i j = fw m n k i j i j" using Suc_innermost_id2 by simp
thus ?thesis using 1 single_iteration_inv[of i n] by simp
qed
lemma Suc_innermost_mono:
"i ≤ n ⟹ j ≤ n ⟹ fw m n (Suc k) i j i j ≤ fw m n k i j i j"
proof (cases j)
case 0
assume "i ≤ n"
thus ?thesis
proof (cases i)
case 0 thus ?thesis using ‹j = 0› single_iteration_inv[of 0 n 0 n n m k]
by (simp add: fw_upd_def upd_def)
next
case (Suc i')
thus ?thesis using Suc_innermost_id1 ‹i ≤ n› ‹j = 0›
by (auto simp: fw_upd_def upd_def local.min.coboundedI1)
qed
next
case (Suc j')
assume "i ≤ n" "j ≤ n"
thus ?thesis using Suc Suc_innermost_id2 by (auto simp: fw_upd_def upd_def local.min.coboundedI1)
qed
lemma fw_mono':
"i ≤ n ⟹ j ≤ n ⟹ fw m n k i j i j ≤ m i j"
proof (induction k)
case 0 thus ?case using fw_outermost_mono by simp
next
case (Suc k) thus ?case using Suc_innermost_mono[OF Suc.prems, of m k] by simp
qed
lemma fw_mono:
"i ≤ n ⟹ j ≤ n ⟹ i' ≤ n ⟹ j' ≤ n ⟹ fw m n k i j i' j' ≤ m i' j'"
proof (cases k)
case 0
assume 0: "i ≤ n" "j ≤ n" "i' ≤ n" "j' ≤ n" "k = 0"
thus ?thesis
proof (cases "i' ≤ i")
case False thus ?thesis using 0 fw_innermost_id by simp
next
case True thus ?thesis
proof (cases "j' ≤ j")
case True
have "fw m n 0 i j i' j' ≤ fw m n 0 i' j' i' j'" using fw_invariant True ‹i' ≤ i› 0 by simp
also have "fw m n 0 i' j' i' j' ≤ m i' j'" using 0 fw_outermost_mono by blast
finally show ?thesis by (simp add: ‹k = 0›)
next
case False thus ?thesis
proof (cases "i = i'", goal_cases)
case 1 then show ?thesis using fw_middle_id[of i' n j' j i' m] 0 by simp
next
case 2
then show ?case
using single_iteration_inv'[of i' i j' n j m 0] ‹i' ≤ i› fw_middle_id[of i' n j' j i' m]
fw_outermost_mono[of i' n j' m] 0
by simp
qed
qed
qed
next
case (Suc k)
assume prems: "i ≤ n" "j ≤ n" "i' ≤ n" "j' ≤ n"
thus ?thesis
proof (cases "i' ≤ i ∧ j' ≤ j")
case True
hence "fw m n (Suc k) i j i' j' = fw m n (Suc k) i' j' i' j'"
using prems single_iteration_inv by blast
thus ?thesis using Suc prems fw_mono' by auto
next
case False thus ?thesis
proof auto
assume "¬ i' ≤ i"
thus ?thesis using Suc prems fw_mono' Suc_innermost_id1 by auto
next
assume "¬ j' ≤ j"
hence "j < j'" by simp
show ?thesis
proof (cases "i ≤ i'")
case True
thus ?thesis using Suc prems Suc_innermost_id2 ‹j < j'› fw_mono' by auto
next
case False
thus ?thesis using single_iteration_inv' Suc prems fw_mono' by auto
qed
qed
qed
qed
lemma add_mono_neutr:
assumes "𝟭 ≤ b"
shows "a ≤ a + b"
using neutr add_mono assms by force
lemma add_mono_neutl:
assumes "𝟭 ≤ b"
shows "a ≤ b + a"
using neutr add_mono assms by force
lemma fw_step_0:
"m 0 0 ≥ 𝟭 ⟹ i ≤ n ⟹ j ≤ n ⟹ fw m n 0 i j i j = min (m i j) (m i 0 + m 0 j)"
proof (induction i)
case 0 thus ?case
proof (cases j)
case 0 thus ?thesis by (simp add: fw_upd_def upd_def)
next
case (Suc j)
hence "fw m n 0 0 j 0 (Suc j) = m 0 (Suc j)" using 0 fw_middle_id[of 0 n "Suc j" j 0 m] by fast
moreover have "fw m n 0 0 j 0 0 = m 0 0" using single_iteration_inv[of 0 0 0 j n m 0] Suc 0
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
qed
next
case (Suc i)
note A = this
show ?case
proof (cases j)
case 0
have "fw m n 0 i n (Suc i) 0 = m (Suc i) 0" using fw_innermost_id[of "Suc i" n 0 n i m] Suc by simp
moreover have "fw m n 0 i n 0 0 = m 0 0" using Suc single_iteration_inv[of 0 i 0 n n m 0]
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
ultimately show ?thesis using 0 by (simp add: fw_upd_def upd_def)
next
case (Suc j)
have *: "fw m n 0 0 j 0 0 = m 0 0" using single_iteration_inv[ of 0 0 0 j n m 0] A Suc
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
have **: "fw m n 0 i n 0 0 = m 0 0" using single_iteration_inv[of 0 i 0 n n m 0] A
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
have "m 0 (Suc j) = fw_upd m 0 0 (Suc j) 0 (Suc j)" using ‹m 0 0 >= 𝟭›
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutl)
also have "… = fw m n 0 0 (Suc j) 0 (Suc j)" using fw_middle_id[of 0 n "Suc j" j 0 m] Suc A(4)
by (simp add: fw_upd_def upd_def *)
finally have ***: "fw m n 0 (Suc i) j 0 (Suc j) = m 0 (Suc j)"
using single_iteration_inv'[of 0 "Suc i" "Suc j" n j m 0] A Suc by simp
have "m (Suc i) 0 = fw_upd m 0 (Suc i) 0 (Suc i) 0" using ‹m 0 0 >= 𝟭›
by (auto simp add: fw_upd_def upd_def min_def intro: add_mono_neutr)
also have "… = fw m n 0 (Suc i) 0 (Suc i) 0"
using fw_innermost_id[of "Suc i" n 0 n i m] ‹Suc i ≤ n› ** by (simp add: fw_upd_def upd_def)
finally have "fw m n 0 (Suc i) j (Suc i) 0 = m (Suc i) 0"
using single_iteration_inv A Suc by auto
moreover have "fw m n 0 (Suc i) j (Suc i) (Suc j) = m (Suc i) (Suc j)"
using fw_middle_id A Suc by simp
ultimately show ?thesis using Suc *** by (simp add: fw_upd_def upd_def)
qed
qed
lemma fw_step_Suc:
"∀ k'≤n. fw m n k n n k' k' ≥ 𝟭 ⟹ i ≤ n ⟹ j ≤ n ⟹ Suc k ≤ n
⟹ fw m n (Suc k) i j i j = min (fw m n k n n i j) (fw m n k n n i (Suc k) + fw m n k n n (Suc k) j)"
proof (induction i)
case 0 thus ?case
proof (cases j)
case 0 thus ?thesis by (simp add: fw_upd_def upd_def)
next
case (Suc j)
then have
"fw m n k n n 0 (Suc j) = fw m n (Suc k) 0 j 0 (Suc j)"
using 0(2-) Suc_innermost_id2' by simp
moreover have "fw m n (Suc k) 0 j 0 (Suc k) = fw m n k n n 0 (Suc k)"
proof (cases "j < Suc k")
case True thus ?thesis using 0 Suc_innermost_id2' by simp
next
case False
hence
"fw m n (Suc k) 0 k 0 (Suc k) = fw m n k n n 0 (Suc k)"
using 0(2-) Suc Suc_innermost_id2' by simp
moreover have "fw m n (Suc k) 0 k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
using 0(2-) Suc Suc_innermost_id2' by simp
moreover have "fw m n (Suc k) 0 j 0 (Suc k) = fw m n (Suc k) 0 (Suc k) 0 (Suc k)"
using False single_iteration_inv 0(2-) Suc by force
ultimately show ?thesis using 0(1)
by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutr)
qed
moreover have "fw m n k n n (Suc k) (Suc j) = fw m n (Suc k) 0 j (Suc k) (Suc j)"
using 0(2-) Suc Suc_innermost_id2' by simp
ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
qed
next
case (Suc i)
note A = this
show ?case
proof (cases j)
case 0
hence
"fw m n (Suc k) i n (Suc i) 0 = fw m n k n n (Suc i) 0"
using Suc_innermost_id1' ‹Suc i ≤ n› by simp
moreover have "fw m n (Suc k) i n (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
using Suc_innermost_id1' A(3,5) by simp
moreover have "fw m n (Suc k) i n (Suc k) 0 = fw m n k n n (Suc k) 0"
proof (cases "i < Suc k")
case True thus ?thesis using Suc_innermost_id1' A(3,5) by simp
next
case False
have "fw m n (Suc k) k n (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
using Suc_innermost_id1' ‹Suc i ≤ n› False by simp
moreover have "fw m n (Suc k) k n (Suc k) 0 = fw m n k n n (Suc k) 0"
using Suc_innermost_id1' ‹Suc i ≤ n› False by simp
moreover have "fw m n (Suc k) i n (Suc k) 0 = fw m n (Suc k) (Suc k) 0 (Suc k) 0"
using single_iteration_inv ‹Suc i ≤ n› False by simp
ultimately show ?thesis using Suc(2)
by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutl)
qed
ultimately show ?thesis using 0 by (simp add: fw_upd_def upd_def)
next
case (Suc j)
hence "fw m n (Suc k) (Suc i) j (Suc i) (Suc j) = fw m n k n n (Suc i) (Suc j)"
using Suc_innermost_id2' A(3,4) by simp
moreover have "fw m n (Suc k) (Suc i) j (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
proof (cases "j < Suc k")
case True thus ?thesis using Suc A(3-) Suc_innermost_id2' by simp
next
case False
have *:"fw m n (Suc k) (Suc i) k (Suc i) (Suc k) = fw m n k n n (Suc i) (Suc k)"
using Suc_innermost_id2' A(3,5) by simp
have **:"fw m n (Suc k) (Suc i) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
proof (cases "Suc i ≤ Suc k")
case True thus ?thesis using Suc_innermost_id2' A(5) by simp
next
case False
hence "fw m n (Suc k) (Suc i) k (Suc k) (Suc k) = fw m n (Suc k) (Suc k) (Suc k) (Suc k) (Suc k)"
using single_iteration_inv'[of "Suc k" "Suc i" "Suc k" n k m "Suc k"] A(3) by simp
moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
using Suc_innermost_id2' A(5) by simp
ultimately show ?thesis using A(2)
by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutl)
qed
have "fw m n (Suc k) (Suc i) j (Suc i) (Suc k) = fw m n (Suc k) (Suc i) (Suc k) (Suc i) (Suc k)"
using False single_iteration_inv[of "Suc i" "Suc i" "Suc k" j n m "Suc k"] A(3-) Suc by simp
also have "… = fw m n k n n (Suc i) (Suc k)" using * ** A(2)
by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutr)
finally show ?thesis by simp
qed
moreover have "fw m n (Suc k) (Suc i) j (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
proof (cases "Suc i ≤ Suc k")
case True thus ?thesis using Suc_innermost_id2' Suc A(3-5) by simp
next
case False
have "fw m n (Suc k) (Suc k) j (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
proof (cases "j < Suc k")
case True thus ?thesis using Suc_innermost_id2' A(5) by simp
next
case False
hence "fw m n (Suc k) (Suc k) j (Suc k) (Suc k) = fw m n (Suc k) (Suc k) (Suc k) (Suc k) (Suc k)"
using single_iteration_inv A(3,4) Suc by simp
moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
using Suc_innermost_id2' A(5) by simp
ultimately show ?thesis using A(2)
by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutl)
qed
moreover have "fw m n (Suc k) (Suc k) j (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
using Suc_innermost_id2' Suc A(3-5) by simp
ultimately have "fw m n (Suc k) (Suc k) (Suc j) (Suc k) (Suc j) = fw m n k n n (Suc k) (Suc j)"
using A(2) by (auto simp add: fw_upd_def upd_def ‹Suc k ≤ n› min_def intro: add_mono_neutl)
moreover have "fw m n (Suc k) (Suc i) j (Suc k) (Suc j) = fw m n (Suc k) (Suc k) (Suc j) (Suc k) (Suc j)"
using single_iteration_inv'[of "Suc k" "Suc i" "Suc j" n j m "Suc k"] Suc A(3-) False by simp
moreover have "fw m n (Suc k) (Suc k) k (Suc k) (Suc k) = fw m n k n n (Suc k) (Suc k)"
using Suc_innermost_id2' A(5) by simp
ultimately show ?thesis using A(2) by (simp add: fw_upd_def upd_def)
qed
ultimately show ?thesis using Suc by (simp add: fw_upd_def upd_def)
qed
qed
subsection ‹Length of Paths›
fun len :: "'a mat ⇒ nat ⇒ nat ⇒ nat list ⇒ 'a" where
"len m u v [] = m u v" |
"len m u v (w#ws) = m u w + len m w v ws"
lemma len_decomp: "xs = ys @ y # zs ⟹ len m x z xs = len m x y ys + len m y z zs"
by (induction ys arbitrary: x xs) (simp add: assoc)+
lemma len_comp: "len m a c (xs @ b # ys) = len m a b xs + len m b c ys"
by (induction xs arbitrary: a) (auto simp: assoc)
subsection ‹Shortening Negative Cycles›
lemma remove_cycles_neg_cycles_aux:
fixes i xs ys
defines "xs' ≡ i # ys"
assumes "i ∉ set ys"
assumes "i ∈ set xs"
assumes "xs = as @ concat (map ((#) i) xss) @ xs'"
assumes "len m i j ys > len m i j xs"
shows "∃ ys. set ys ⊆ set xs ∧ len m i i ys < 𝟭" using assms
proof (induction xss arbitrary: xs as)
case Nil
with Nil show ?case
proof (cases "len m i i as ≥ 𝟭", goal_cases)
case 1
from this(4,6) len_decomp[of xs as i ys m i j]
have "len m i j xs = len m i i as + len m i j ys" by simp
with 1(11)
have "len m i j ys ≤ len m i j xs" using add_mono by fastforce
thus ?thesis using Nil(5) by auto
next
case 2 thus ?case by auto
qed
next
case (Cons zs xss)
let ?xs = "zs @ concat (map ((#) i) xss) @ xs'"
from Cons show ?case
proof (cases "len m i i as ≥ 𝟭", goal_cases)
case 1
from this(5,7) len_decomp add_mono
have "len m i j ?xs ≤ len m i j xs" by fastforce
hence 4:"len m i j ?xs < len m i j ys" using 1(6) by simp
have 2:"i ∈ set ?xs" using Cons(2) by auto
have "set ?xs ⊆ set xs" using Cons(5) by auto
moreover from Cons(1)[OF 1(2,3) 2 _ 4] have "∃ys. set ys ⊆ set ?xs ∧ len m i i ys < 𝟭" by auto
ultimately show ?case by blast
next
case 2
from this(5,7) show ?case by auto
qed
qed
lemma add_lt_neutral: "a + b < b ⟹ a < 𝟭"
proof (rule ccontr)
assume "a + b < b" "¬ a < 𝟭"
hence "a ≥ 𝟭" by auto
from add_mono[OF this, of b b] ‹a + b < b› show False by auto
qed
lemma remove_cycles_neg_cycles_aux':
fixes j xs ys
assumes "j ∉ set ys"
assumes "j ∈ set xs"
assumes "xs = ys @ j # concat (map (λ xs. xs @ [j]) xss) @ as"
assumes "len m i j ys > len m i j xs"
shows "∃ ys. set ys ⊆ set xs ∧ len m j j ys < 𝟭" using assms
proof (induction xss arbitrary: xs as)
case Nil
show ?case
proof (cases "len m j j as ≥ 𝟭")
case True
from Nil(3) len_decomp[of xs ys j as m i j]
have "len m i j xs = len m i j ys + len m j j as" by simp
with True
have "len m i j ys ≤ len m i j xs" using add_mono by fastforce
with Nil show ?thesis by auto
next
case False with Nil show ?thesis by auto
qed
next
case (Cons zs xss)
let ?xs = "ys @ j # concat (map (λxs. xs @ [j]) xss) @ as"
let ?t = "concat (map (λxs. xs @ [j]) xss) @ as"
show ?case
proof (cases "len m i j ?xs ≤ len m i j xs")
case True
hence 4:"len m i j ?xs < len m i j ys" using Cons(5) by simp
have 2:"j ∈ set ?xs" using Cons(2) by auto
have "set ?xs ⊆ set xs" using Cons(4) by auto
moreover from Cons(1)[OF Cons(2) 2 _ 4] have "∃ys. set ys ⊆ set ?xs ∧ len m j j ys < 𝟭" by blast
ultimately show ?thesis by blast
next
case False
hence "len m i j xs < len m i j ?xs" by auto
from this len_decomp Cons(4) add_mono
have "len m j j (concat (map (λxs. xs @ [j]) (zs # xss)) @ as) < len m j j ?t"
using False local.leI by fastforce
hence "len m j j (zs @ j # ?t) < len m j j ?t" by simp
with len_decomp[of "zs @ j # ?t" zs j ?t m j j]
have "len m j j zs + len m j j ?t < len m j j ?t" by auto
hence "len m j j zs < 𝟭" using add_lt_neutral by auto
thus ?thesis using Cons.prems(3) by auto
qed
qed
lemma add_le_impl: "a + b < a + c ⟹ b < c"
proof (rule ccontr)
assume "a + b < a + c" "¬ b < c"
hence "b ≥ c" by auto
from add_mono[OF _ this, of a a] ‹a + b < a + c› show False by auto
qed
lemma start_remove_neg_cycles:
"len m i j (start_remove xs k []) > len m i j xs ⟹ ∃ ys. set ys ⊆ set xs ∧ len m k k ys < 𝟭"
proof-
let ?xs = "start_remove xs k []"
assume len_lt:"len m i j ?xs > len m i j xs"
hence "k ∈ set xs" using start_remove_id by fastforce
from start_remove_decomp[OF this, of "[]"] obtain as bs where as_bs:
"xs = as @ k # bs" "?xs = as @ remove_cycles bs k [k]"
by fastforce
let ?xs' = "remove_cycles bs k [k]"
have "k ∈ set bs" using as_bs len_lt remove_cycles_id by fastforce
then obtain ys where ys: "?xs = as @ k # ys" "?xs' = k # ys" "k ∉ set ys"
using as_bs(2) remove_cycles_begins_with[OF ‹k ∈ set bs›] by auto
have len_lt': "len m k j bs < len m k j ys"
using len_decomp[OF as_bs(1), of m i j] len_decomp[OF ys(1), of m i j] len_lt add_le_impl by metis
from remove_cycles_cycles[OF ‹k ∈ set bs›] obtain xss as'
where "as' @ concat (map ((#) k) xss) @ ?xs' = bs" by fastforce
hence "as' @ concat (map ((#) k) xss) @ k # ys = bs" using ys(2) by simp
from remove_cycles_neg_cycles_aux[OF ‹k ∉ set ys› ‹k ∈ set bs› this[symmetric] len_lt']
show ?thesis using as_bs(1) by auto
qed
lemma remove_all_cycles_neg_cycles:
"len m i j (remove_all_cycles ys xs) > len m i j xs
⟹ ∃ ys k. set ys ⊆ set xs ∧ k ∈ set xs ∧ len m k k ys < 𝟭"
proof (induction ys arbitrary: xs)
case Nil thus ?case by auto
next
case (Cons y ys)
let ?xs = "start_remove xs y []"
show ?case
proof (cases "len m i j xs < len m i j ?xs")
case True
with start_remove_id have "y ∈ set xs" by fastforce
with start_remove_neg_cycles[OF True] show ?thesis by blast
next
case False
with Cons(2) have "len m i j ?xs < len m i j (remove_all_cycles (y # ys) xs)" by auto
hence "len m i j ?xs < len m i j (remove_all_cycles ys ?xs)" by auto
from Cons(1)[OF this] show ?thesis using start_remove_subs[of xs y "[]"] by auto
qed
qed
lemma (in -) concat_map_cons_rev:
"rev (concat (map ((#) j) xss)) = concat (map (λ xs. xs @ [j]) (rev (map rev xss)))"
by (induction xss) auto
lemma negative_cycle_dest: "len m i j (rem_cycles i j xs) > len m i j xs
⟹ ∃ i' ys. len m i' i' ys < 𝟭 ∧ set ys ⊆ set xs ∧ i' ∈ set (i # j # xs)"
proof -
let ?xsij = "rem_cycles i j xs"
let ?xsj = "remove_all_rev j (remove_all_cycles xs xs)"
let ?xs = "remove_all_cycles xs xs"
assume len_lt: "len m i j ?xsij > len m i j xs"
show ?thesis
proof (cases "len m i j ?xsij ≤ len m i j ?xsj")
case True
hence len_lt: "len m i j ?xsj > len m i j xs" using len_lt by simp
show ?thesis
proof (cases "len m i j ?xsj ≤ len m i j ?xs")
case True
hence "len m i j ?xs > len m i j xs" using len_lt by simp
with remove_all_cycles_neg_cycles[OF this] show ?thesis by auto
next
case False
then have len_lt': "len m i j ?xsj > len m i j ?xs" by simp
show ?thesis
proof (cases "j ∈ set ?xs")
case False
thus ?thesis using len_lt' by (simp add: remove_all_rev_def)
next
case True
from remove_all_rev_removes[of j] have 1: "j ∉ set ?xsj" by simp
from True have "j ∈ set (rev ?xs)" by auto
from remove_cycles_cycles[OF this] obtain xss as where as:
"as @ concat (map ((#) j) xss) @ remove_cycles (rev ?xs) j [] = rev ?xs" "j ∉ set as"
by blast
from True have "?xsj = rev (tl (remove_cycles (rev ?xs) j []))" by (simp add: remove_all_rev_def)
with remove_cycles_begins_with[OF ‹j ∈ set (rev ?xs)›, of "[]"]
have "remove_cycles (rev ?xs) j [] = j # rev ?xsj" "j ∉ set ?xsj"
by auto
with as(1) have xss: "as @ concat (map ((#) j) xss) @ j # rev ?xsj = rev ?xs" by simp
hence "rev (as @ concat (map ((#) j) xss) @ j # rev ?xsj) = ?xs" by simp
hence "?xsj @ j # rev (concat (map ((#) j) xss)) @ rev as = ?xs" by simp
hence "?xsj @ j # concat (map (λ xs. xs @ [j]) (rev (map rev xss))) @ rev as = ?xs"
by (simp add: concat_map_cons_rev)
from remove_cycles_neg_cycles_aux'[OF 1 True this[symmetric] len_lt']
show ?thesis using remove_all_cycles_subs by fastforce
qed
qed
next
case False
hence len_lt': "len m i j ?xsij > len m i j ?xsj" by simp
show ?thesis
proof (cases "i ∈ set ?xsj")
case False
thus ?thesis using len_lt' by (simp add: remove_all_def)
next
case True
from remove_all_removes[of i] have 1: "i ∉ set ?xsij" by (simp add: remove_all_def)
from remove_cycles_cycles[OF True] obtain xss as where as:
"as @ concat (map ((#) i) xss) @ remove_cycles ?xsj i [] = ?xsj" "i ∉ set as" by blast
from True have "?xsij = tl (remove_cycles ?xsj i [])" by (simp add: remove_all_def)
with remove_cycles_begins_with[OF True, of "[]"]
have "remove_cycles ?xsj i [] = i # ?xsij" "i ∉ set ?xsij"
by auto
with as(1) have xss: "as @ concat (map ((#) i) xss) @ i # ?xsij = ?xsj" by simp
from remove_cycles_neg_cycles_aux[OF 1 True this[symmetric] len_lt']
show ?thesis using remove_all_rev_subs remove_all_cycles_subs by fastforce
qed
qed
qed
section ‹Definition of Shortest Paths›
definition D :: "'a mat ⇒ nat ⇒ nat ⇒ nat ⇒ 'a" where
"D m i j k ≡ Min {len m i j xs | xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
lemma (in -) distinct_length_le:"finite s ⟹ set xs ⊆ s ⟹ distinct xs ⟹ length xs ≤ card s"
by (metis card_mono distinct_card)
lemma (in -) finite_distinct: "finite s ⟹ finite {xs . set xs ⊆ s ∧ distinct xs}"
proof -
assume "finite s"
hence "{xs . set xs ⊆ s ∧ distinct xs} ⊆ {xs. set xs ⊆ s ∧ length xs ≤ card s}"
using distinct_length_le by auto
moreover have "finite {xs. set xs ⊆ s ∧ length xs ≤ card s}"
using finite_lists_length_le[OF ‹finite s›] by auto
ultimately show ?thesis by (rule finite_subset)
qed
lemma D_base_finite:
"finite {len m i j xs | xs. set xs ⊆ {0..k} ∧ distinct xs}"
using finite_distinct finite_image_set by blast
lemma D_base_finite':
"finite {len m i j xs | xs. set xs ⊆ {0..k} ∧ distinct (i # j # xs)}"
proof -
have "{len m i j xs | xs. set xs ⊆ {0..k} ∧ distinct (i # j # xs)}
⊆ {len m i j xs | xs. set xs ⊆ {0..k} ∧ distinct xs}" by auto
with D_base_finite[of m i j k] show ?thesis by (rule rev_finite_subset)
qed
lemma D_base_finite'':
"finite {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
using D_base_finite[of m i j k] by - (rule finite_subset, auto)
definition cycle_free :: "'a mat ⇒ nat ⇒ bool" where
"cycle_free m n ≡ ∀ i xs. i ≤ n ∧ set xs ⊆ {0..n} ⟶
(∀ j. j ≤ n ⟶ len m i j (rem_cycles i j xs) ≤ len m i j xs) ∧ len m i i xs ≥ 𝟭"
lemma D_eqI:
fixes m n i j k
defines "A ≡ {len m i j xs | xs. set xs ⊆ {0..k}}"
defines "A_distinct ≡ {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
assumes "cycle_free m n" "i ≤ n" "j ≤ n" "k ≤ n" "(⋀y. y ∈ A_distinct ⟹ x ≤ y)" "x ∈ A"
shows "D m i j k = x" using assms
proof -
let ?S = "{len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
show ?thesis unfolding D_def
proof (rule Min_eqI)
have "?S ⊆ {len m i j xs |xs. set xs ⊆ {0..k} ∧ distinct xs}" by auto
thus "finite {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
using D_base_finite[of m i j k] by (rule finite_subset)
next
fix y assume "y ∈ ?S"
hence "y ∈ A_distinct" using assms(2,7) by fastforce
thus "x ≤ y" using assms by meson
next
from assms obtain xs where xs: "x = len m i j xs" "set xs ⊆ {0..k}" by auto
let ?ys = "rem_cycles i j xs"
let ?y = "len m i j ?ys"
from assms(3-6) xs have *:"?y ≤ x" by (fastforce simp add: cycle_free_def)
have distinct: "i ∉ set ?ys" "j ∉ set ?ys" "distinct ?ys"
using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
with xs(2) have "?y ∈ A_distinct" unfolding A_distinct_def using rem_cycles_subs by fastforce
hence "x ≤ ?y" using assms by meson
moreover have "?y ≤ x" using assms(3-6) xs by (fastforce simp add: cycle_free_def)
ultimately have "x = ?y" by simp
thus "x ∈ ?S" using distinct xs(2) rem_cycles_subs[of i j xs] by fastforce
qed
qed
lemma D_base_not_empty:
"{len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs} ≠ {}"
proof -
have "len m i j [] ∈ {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
by fastforce
thus ?thesis by auto
qed
lemma Min_elem_dest: "finite A ⟹ A ≠ {} ⟹ x = Min A ⟹ x ∈ A" by simp
lemma D_dest: "x = D m i j k ⟹
x ∈ {len m i j xs |xs. set xs ⊆ {0..Suc k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)
lemma D_dest': "x = D m i j k ⟹ x ∈ {len m i j xs |xs. set xs ⊆ {0..Suc k}}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)
lemma D_dest'': "x = D m i j k ⟹ x ∈ {len m i j xs |xs. set xs ⊆ {0..k}}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)
lemma cycle_free_loop_dest: "i ≤ n ⟹ set xs ⊆ {0..n} ⟹ cycle_free m n ⟹ len m i i xs ≥ 𝟭"
unfolding cycle_free_def by auto
lemma cycle_free_dest:
"cycle_free m n ⟹ i ≤ n ⟹ j ≤ n ⟹ set xs ⊆ {0..n}
⟹ len m i j (rem_cycles i j xs) ≤ len m i j xs"
by (auto simp add: cycle_free_def)
definition cycle_free_up_to :: "'a mat ⇒ nat ⇒ nat ⇒ bool" where
"cycle_free_up_to m k n ≡ ∀ i xs. i ≤ n ∧ set xs ⊆ {0..k} ⟶
(∀ j. j ≤ n ⟶ len m i j (rem_cycles i j xs) ≤ len m i j xs) ∧ len m i i xs ≥ 𝟭"
lemma cycle_free_up_to_loop_dest:
"i ≤ n ⟹ set xs ⊆ {0..k} ⟹ cycle_free_up_to m k n ⟹ len m i i xs ≥ 𝟭"
unfolding cycle_free_up_to_def by auto
lemma cycle_free_up_to_diag:
assumes "cycle_free_up_to m k n" "i ≤ n"
shows "m i i ≥ 𝟭"
using cycle_free_up_to_loop_dest[OF assms(2) _ assms(1), of "[]"] by auto
lemma D_eqI2:
fixes m n i j k
defines "A ≡ {len m i j xs | xs. set xs ⊆ {0..k}}"
defines "A_distinct ≡ {len m i j xs | xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
assumes "cycle_free_up_to m k n" "i ≤ n" "j ≤ n" "k ≤ n"
"(⋀y. y ∈ A_distinct ⟹ x ≤ y)" "x ∈ A"
shows "D m i j k = x" using assms
proof -
show ?thesis
proof (simp add: D_def A_distinct_def[symmetric], rule Min_eqI)
show "finite A_distinct" using D_base_finite''[of m i j k] unfolding A_distinct_def by auto
next
fix y assume "y ∈ A_distinct"
thus "x ≤ y" using assms by meson
next
from assms obtain xs where xs: "x = len m i j xs" "set xs ⊆ {0..k}" by auto
let ?ys = "rem_cycles i j xs"
let ?y = "len m i j ?ys"
from assms(3-6) xs have *:"?y ≤ x" by (fastforce simp add: cycle_free_up_to_def)
have distinct: "i ∉ set ?ys" "j ∉ set ?ys" "distinct ?ys"
using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
with xs(2) have "?y ∈ A_distinct" unfolding A_distinct_def using rem_cycles_subs by fastforce
hence "x ≤ ?y" using assms by meson
moreover have "?y ≤ x" using assms(3-6) xs by (fastforce simp add: cycle_free_up_to_def)
ultimately have "x = ?y" by simp
then show "x ∈ A_distinct" using distinct xs(2) rem_cycles_subs[of i j xs]
unfolding A_distinct_def by fastforce
qed
qed
section ‹Result Under The Absence of Negative Cycles›
text ‹
This proves that the algorithm correctly computes shortest paths under the absence of negative
cycles by a standard argument.
›
theorem fw_shortest_path_up_to:
"cycle_free_up_to m k n ⟹ i' ≤ i ⟹ j' ≤ j ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n
⟹ D m i' j' k = fw m n k i j i' j'"
proof (induction k arbitrary: i j i' j')
case 0
from cycle_free_up_to_diag[OF 0(1)] have diag: "∀ k ≤ n. m k k ≥ 𝟭" by auto
then have m_diag: "m 0 0 ≥ 𝟭" by simp
let ?S = "{len m i' j' xs |xs. set xs ⊆ {0} ∧ i' ∉ set xs ∧ j' ∉ set xs ∧ distinct xs}"
show ?case unfolding D_def
proof (simp, rule Min_eqI)
have "?S ⊆ {len m i' j' xs |xs. set xs ⊆ {0..0} ∧ distinct xs}" by auto
thus "finite ?S" using D_base_finite[of m i' j' 0] by (rule finite_subset)
next
fix l assume "l ∈ ?S"
then obtain xs where l: "l = len m i' j' xs" and xs: "xs = [] ∨ xs = [0]"
using distinct_list_single_elem_decomp by auto
{ assume "xs = []"
have "fw m n 0 i j i' j' ≤ fw m n 0 0 0 i' j'" using fw_invariant 0 by blast
also have "… ≤ m i' j'" by (cases "i' = 0 ∧ j' = 0") (simp add: fw_upd_def upd_def)+
finally have "fw m n 0 i j i' j' ≤ l" using ‹xs = []› l by simp
}
moreover
{ assume "xs = [0]"
have "fw m n 0 i j i' j' ≤ fw m n 0 i' j' i' j'" using fw_invariant 0 by blast
also have "… ≤ m i' 0 + m 0 j'"
proof (cases j')
assume "j' = 0"
show ?thesis
proof (cases i')
assume "i' = 0"
thus ?thesis using ‹j' = 0› by (simp add: fw_upd_def upd_def)
next
fix i'' assume i'': "i' = Suc i''"
have "fw_upd (fw m n 0 i'' n) 0 (Suc i'') 0 (Suc i'') 0 ≤ fw m n 0 i'' n (Suc i'') 0"
by (simp add: fw_upd_mono)
also have "… ≤ m (Suc i'') 0" using fw_mono 0 i'' by simp
finally show ?thesis using ‹j' = 0› m_diag i'' neutr add_mono by fastforce
qed
next
fix j'' assume j'': "j' = Suc j''"
have "fw_upd (fw m n 0 i' j'') 0 i' (Suc j'') i' (Suc j'')
≤ fw m n 0 i' j'' i' 0 + fw m n 0 i' j'' 0 (Suc j'') "
by (simp add: fw_upd_def upd_def)
also have "… ≤ m i' 0 + m 0 (Suc j'')"
using fw_mono[of i' n j'' i' 0 m 0] fw_mono[of i' n j'' 0 "Suc j''" m 0 ] j'' 0
by (simp add: add_mono)
finally show ?thesis using j'' by simp
qed
finally have "fw m n 0 i j i' j' ≤ l" using ‹xs = [0]› l by simp
}
ultimately show "fw m n 0 i j i' j' ≤ l" using xs by auto
next
have A: "fw m n 0 i j i' j' = fw m n 0 i' j' i' j'" using single_iteration_inv 0 by blast
have "fw m n 0 i' j' i' j' = min (m i' j') (m i' 0 + m 0 j')"
using 0 by (simp add: fw_step_0[of m, OF m_diag])
hence
"fw m n 0 i' j' i' j' = m i' j'
∨ (fw m n 0 i' j' i' j' = m i' 0 + m 0 j'∧ m i' 0 + m 0 j' ≤ m i' j')"
by (auto simp add: ord.min_def)
thus "fw m n 0 i j i' j' ∈ ?S"
proof (standard, goal_cases)
case 1
hence "fw m n 0 i j i' j' = len m i' j' []" using A by auto
thus ?case by fastforce
next
case 2
hence *:"fw m n 0 i j i' j' = len m i' j' [0]" using A by auto
thus ?case
proof (cases "i' = 0 ∨ j' = 0")
case False thus ?thesis using * by fastforce
next
case True
{ assume "i' = 0"
from diag have "m 0 0 + m 0 j' ≥ m 0 j'" by (auto intro: add_mono_neutl)
with ‹i' = 0› have "fw m n 0 i j i' j' = len m 0 j' []" using 0 A 2 by auto
} moreover
{ assume "j' = 0"
from diag have "m i' 0 + m 0 0 ≥ m i' 0" by (auto intro: add_mono_neutr)
with ‹j' = 0› have "fw m n 0 i j i' j' = len m i' 0 []" using 0 A 2 by auto
}
ultimately have "fw m n 0 i j i' j' = len m i' j' []" using True by auto
then show ?thesis by fastforce
qed
qed
qed
next
case (Suc k)
from cycle_free_up_to_diag[OF Suc.prems(1)] have diag: "∀ k ≤ n. m k k ≥ 𝟭" by auto
from Suc.prems have cycle_free_to_k:
"cycle_free_up_to m k n" by (fastforce simp add: cycle_free_up_to_def)
{ fix k' assume "k' ≤ n"
with Suc cycle_free_to_k have "D m k' k' k = fw m n k n n k' k'" by auto
from D_dest''[OF this[symmetric]] obtain xs where
"set xs ⊆ {0..k}" "fw m n k n n k' k'= len m k' k' xs"
by auto
with Suc(2) ‹Suc k ≤ n› ‹k' ≤ n› have "fw m n k n n k' k' ≥ 𝟭"
unfolding cycle_free_up_to_def by force
}
hence K: "∀k'≤n. fw m n k n n k' k' ≥ 𝟭" by simp
let ?S = "λ k i j. {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
show ?case
proof (rule D_eqI2)
show "cycle_free_up_to m (Suc k) n" using Suc.prems(1) .
next
show "i' ≤ n" using Suc.prems by simp
next
show "j' ≤ n" using Suc.prems by simp
next
show "Suc k ≤ n" using Suc.prems by simp
next
fix l assume "l ∈ {len m i' j' xs | xs. set xs ⊆ {0..Suc k} ∧ i' ∉ set xs ∧ j' ∉ set xs ∧ distinct xs}"
then obtain xs where xs:
"l = len m i' j' xs" "set xs ⊆ {0..Suc k}" "i' ∉ set xs" "j' ∉ set xs" "distinct xs"
by auto
have IH: "D m i' j' k = fw m n k i j i' j'" using cycle_free_to_k Suc by auto
have fin:
"finite {len m i' j' xs |xs. set xs ⊆ {0..k} ∧ i' ∉ set xs ∧ j' ∉ set xs ∧ distinct xs}"
using D_base_finite'' by simp
show "fw m n (Suc k) i j i' j' ≤ l"
proof (cases "Suc k ∈ set xs")
case False
hence "set xs ⊆ {0..k}" using xs(2) using atLeastAtMostSuc_conv by auto
hence
"l ∈ {len m i' j' xs | xs. set xs ⊆ {0..k} ∧ i' ∉ set xs ∧ j' ∉ set xs ∧ distinct xs}"
using xs by auto
with Min_le[OF fin this] have "fw m n k i j i' j' ≤ l" using IH by (simp add: D_def)
thus ?thesis using fw_invariant[of k "Suc k" i n j j i m i' j'] Suc.prems by simp
next
case True
then obtain ys zs where ys_zs_id: "xs = ys @ Suc k # zs" by (meson split_list)
with xs(5) have ys_zs: "distinct ys" "distinct zs" "Suc k ∉ set ys" "Suc k ∉ set zs"
"set ys ∩ set zs = {}" by auto
have "i' ≠ Suc k" "j' ≠ Suc k" using xs(3,4) True by auto
have "set ys ⊆ {0..k}" using ys_zs(3) xs(2) ys_zs_id using atLeastAtMostSuc_conv by auto
hence "len m i' (Suc k) ys ∈ ?S k i' (Suc k)" using ys_zs_id ys_zs xs(3) by fastforce
with Min_le[OF _ this] have "Min (?S k i' (Suc k)) ≤ len m i' (Suc k) ys"
using D_base_finite'[of m i' "Suc k" k] ‹i' ≠ Suc k› by fastforce
moreover have "fw m n k n n i' (Suc k) = D m i' (Suc k) k"
using Suc.IH[OF cycle_free_to_k, of i' n] Suc.prems by auto
ultimately have *:"fw m n k n n i' (Suc k) ≤ len m i' (Suc k) ys" using ‹i' ≠ Suc k›
by (auto simp: D_def)
have "set zs ⊆ {0..k}" using ys_zs(4) xs(2) ys_zs_id using atLeastAtMostSuc_conv by auto
hence "len m (Suc k) j' zs ∈ ?S k (Suc k) j'" using ys_zs_id ys_zs xs(3,4,5) by fastforce
with Min_le[OF _ this] have "Min (?S k (Suc k) j') ≤ len m (Suc k) j' zs"
using D_base_finite'[of m "Suc k" j' k] ‹j' ≠ Suc k› by fastforce
moreover have "fw m n k n n (Suc k) j' = D m (Suc k) j' k"
using Suc.IH[OF cycle_free_to_k, of "Suc k" n j' n] Suc.prems by auto
ultimately have **:"fw m n k n n (Suc k) j' ≤ len m (Suc k) j' zs" using ‹j' ≠ Suc k›
by (auto simp: D_def)
have len_eq: "l = len m i' (Suc k) ys + len m (Suc k) j' zs"
by (simp add: xs(1) len_decomp[OF ys_zs_id, symmetric] ys_zs_id)
have "fw m n (Suc k) i' j' i' j' ≤ fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j'"
using fw_step_Suc[of n m k i' j', OF K] Suc.prems(2-) by simp
hence "fw m n (Suc k) i' j' i' j' ≤ l"
using fw_step_Suc[of n m k i j] Suc.prems(3-) * ** len_eq add_mono by fastforce
thus ?thesis using fw_invariant[of "Suc k" "Suc k" i n j j' i' m i' j'] Suc.prems(2-) by simp
qed
next
have "fw m n (Suc k) i j i' j' = fw m n (Suc k) i' j' i' j'"
using single_iteration_inv[OF Suc.prems(2-5)] .
also have "… = min (fw m n k n n i' j') (fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j')"
using fw_step_Suc[OF K] Suc.prems(2-) by simp
finally show "fw m n (Suc k) i j i' j' ∈ {len m i' j' xs | xs. set xs ⊆ {0..Suc k}}"
proof (cases "fw m n (Suc k) i j i' j' = fw m n k n n i' j'", goal_cases)
case True
have "fw m n (Suc k) i j i' j' = D m i' j' k"
using Suc.IH[OF cycle_free_to_k, of i' n j' n] Suc.prems(2-) True by simp
from D_dest'[OF this] show ?thesis by blast
next
case 2
hence A:"fw m n (Suc k) i j i' j' = fw m n k n n i' (Suc k) + fw m n k n n (Suc k) j'"
by (metis ord.min_def)
have "fw m n k n n i' j' = D m i' j' k"
using Suc.IH[OF cycle_free_to_k, of i' n j' n] Suc.prems by simp
from D_dest[OF this] have B:"fw m n k n n i' j' ∈ ?S (Suc k) i' j'"
by blast
have "fw m n k n n i' (Suc k) = D m i' (Suc k) k"
using Suc.IH[OF cycle_free_to_k, of i' n "Suc k" n] Suc.prems by simp
from D_dest'[OF this] obtain xs where xs:
"fw m n k n n i' (Suc k) = len m i' (Suc k) xs" "set xs ⊆ {0..Suc k}" by blast
have "fw m n k n n (Suc k) j' = D m (Suc k) j' k"
using Suc.IH[OF cycle_free_to_k, of "Suc k" n j' n] Suc.prems by simp
from D_dest'[OF this] obtain ys where ys:
"fw m n k n n (Suc k) j' = len m (Suc k) j' ys" "set ys ⊆ {0..Suc k}" by blast
from A xs(1) ys(1) len_comp
have "fw m n (Suc k) i j i' j' = len m i' j' (xs @ Suc k # ys)" by simp
moreover have "set (xs @ Suc k # ys) ⊆ {0..Suc k}" using xs(2) ys(2) by auto
ultimately show ?thesis by blast
qed
qed
qed
lemma cycle_free_cycle_free_up_to:
"cycle_free m n ⟹ k ≤ n ⟹ cycle_free_up_to m k n"
unfolding cycle_free_def cycle_free_up_to_def by force
lemma cycle_free_diag:
"cycle_free m n ⟹ i ≤ n ⟹ 𝟭 ≤ m i i"
using cycle_free_up_to_diag[OF cycle_free_cycle_free_up_to] by blast
corollary fw_shortest_path:
"cycle_free m n ⟹ i' ≤ i ⟹ j' ≤ j ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n
⟹ D m i' j' k = fw m n k i j i' j'"
using fw_shortest_path_up_to[OF cycle_free_cycle_free_up_to] by auto
corollary fw_shortest:
assumes "cycle_free m n" "i ≤ n" "j ≤ n" "k ≤ n"
shows "fw m n n n n i j ≤ fw m n n n n i k + fw m n n n n k j"
proof (rule ccontr, goal_cases)
case 1
let ?S = "λ i j. {len m i j xs |xs. set xs ⊆ {0..n}}"
let ?FW = "fw m n n n n"
from assms fw_shortest_path
have FW: "?FW i j = D m i j n" "?FW i k = D m i k n" "?FW k j = D m k j n" by auto
with D_dest'' FW have "?FW i k ∈ ?S i k" "?FW k j ∈ ?S k j" by auto
then obtain xs ys where xs_ys:
"?FW i k = len m i k xs" "set xs ⊆ {0..n}" "?FW k j = len m k j ys" "set ys ⊆ {0..n}" by auto
let ?zs = "rem_cycles i j (xs @ k # ys)"
have *:"?FW i j = Min {len m i j xs |xs. set xs ⊆ {0..n} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
using FW(1) unfolding D_def .
have "set (xs @ k # ys) ⊆ {0..n}" using assms xs_ys by fastforce
from cycle_free_dest [OF ‹cycle_free m n› ‹i ≤ n› ‹j ≤ n› this]
have **:"len m i j ?zs ≤ len m i j (xs @ k # ys)" by auto
moreover have "i ∉ set ?zs" "j ∉ set ?zs" "distinct ?zs"
using rem_cycles_distinct remove_all_removes rem_cycles_removes_last by fast+
moreover have "set ?zs ⊆ {0..n}" using rem_cycles_subs[of i j"xs @ k # ys"] xs_ys assms by fastforce
ultimately have
"len m i j ?zs ∈ {len m i j xs |xs. set xs ⊆ {0..n} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
by blast
with * have "?FW i j ≤ len m i j ?zs" using D_base_finite'' by auto
with ** xs_ys len_comp 1 show ?case by auto
qed
section ‹Result Under the Presence of Negative Cycles›
lemma not_cylce_free_dest: "¬ cycle_free m n ⟹ ∃ k ≤ n. ¬ cycle_free_up_to m k n"
by (auto simp add: cycle_free_def cycle_free_up_to_def)
lemma D_not_diag_le:
"(x :: 'a) ∈ {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}
⟹ D m i j k ≤ x" using Min_le[OF D_base_finite''] by (auto simp add: D_def)
lemma D_not_diag_le': "set xs ⊆ {0..k} ⟹ i ∉ set xs ⟹ j ∉ set xs ⟹ distinct xs
⟹ D m i j k ≤ len m i j xs" using Min_le[OF D_base_finite''] by (fastforce simp add: D_def)
lemma (in -) nat_upto_subs_top_removal':
"S ⊆ {0..Suc n} ⟹ Suc n ∉ S ⟹ S ⊆ {0..n}"
apply (induction n)
apply safe
apply (rename_tac x)
apply (case_tac "x = Suc 0"; fastforce)
apply (rename_tac n x)
apply (case_tac "x = Suc (Suc n)"; fastforce)
done
lemma (in -) nat_upto_subs_top_removal:
"S ⊆ {0..n::nat} ⟹ n ∉ S ⟹ S ⊆ {0..n - 1}"
using nat_upto_subs_top_removal' by (cases n; simp)
lemma fw_Suc:
"i ≤ n ⟹ j ≤ n ⟹ i' ≤ n ⟹ j' ≤ n ⟹ fw m n (Suc k) i' j' i j ≤ fw m n k n n i j"
by (metis Suc_innermost_id1' Suc_innermost_id2 Suc_innermost_mono linorder_class.not_le order.eq_iff
preorder_class.order_refl single_iteration_inv single_iteration_inv')
lemma negative_len_shortest:
"length xs = n ⟹ len m i i xs < 𝟭
⟹ ∃ j ys. distinct (j # ys) ∧ len m j j ys < 𝟭 ∧ j ∈ set (i # xs) ∧ set ys ⊆ set xs"
proof (induction n arbitrary: xs i rule: less_induct)
case (less n)
show ?case
proof (cases xs)
case Nil
thus ?thesis using less.prems by auto
next
case (Cons y ys)
then have "length xs ≥ 1" by auto
show ?thesis
proof (cases "i ∈ set xs")
assume i: "i ∈ set xs"
then obtain as bs where xs: "xs = as @ i # bs" by (meson split_list)
show ?thesis
proof (cases "len m i i as < 𝟭")
case True
from xs less.prems have "length as < n" by auto
from less.IH[OF this _ True] xs show ?thesis by auto
next
case False
from len_decomp[OF xs] have "len m i i xs = len m i i as + len m i i bs" by auto
with False less.prems have *: "len m i i bs < 𝟭"
by (metis add_lt_neutral local.dual_order.strict_trans local.neqE)
from xs less.prems have "length bs < n" by auto
from less.IH[OF this _ *] xs show ?thesis by auto
qed
next
assume i: "i ∉ set xs"
show ?thesis
proof (cases "distinct xs")
case True
with i less.prems show ?thesis by auto
next
case False
from not_distinct_decomp[OF this] obtain a as bs cs where xs:
"xs = as @ a # bs @ a # cs"
by auto
show ?thesis
proof (cases "len m a a bs < 𝟭")
case True
from xs less.prems have "length bs < n" by auto
from less.IH[OF this _ True] xs show ?thesis by auto
next
case False
from len_decomp[OF xs, of m i i] len_decomp[of "bs @ a # cs" bs a cs m a i]
have *:"len m i i xs = len m i a as + (len m a a bs + len m a i cs)" by auto
from False have "len m a a bs ≥ 𝟭" by auto
with add_mono have "len m a a bs + len m a i cs ≥ len m a i cs" by fastforce
with * have "len m i i xs ≥ len m i a as + len m a i cs" by (simp add: add_mono)
with less.prems(2) have "len m i a as + len m a i cs < 𝟭" by auto
with len_comp have "len m i i (as @ a # cs) < 𝟭" by auto
from less.IH[OF _ _ this, of "length (as @ a # cs)"] xs less.prems
show ?thesis by auto
qed
qed
qed
qed
qed
theorem FW_neg_cycle_detect:
"¬ cycle_free m n ⟹ ∃ i ≤ n. fw m n n n n i i < 𝟭"
proof -
assume A: "¬ cycle_free m n"
let ?K = "{k. k ≤ n ∧ ¬ cycle_free_up_to m k n}"
let ?k = "Min ?K"
have not_empty_K: "?K ≠ {}" using not_cylce_free_dest[OF A(1)] by auto
have "finite ?K" by auto
with not_empty_K have *:
"∀ k' < ?k. cycle_free_up_to m k' n"
by (auto, metis le_trans less_or_eq_imp_le preorder_class.less_irrefl)
from linorder_class.Min_in[OF ‹finite ?K› ‹?K ≠ {}›] have
"¬ cycle_free_up_to m ?k n" "?k ≤ n"
by auto
then have "∃ xs j. j ≤ n ∧ len m j j xs < 𝟭 ∧ set xs ⊆ {0..?k}" unfolding cycle_free_up_to_def
proof (auto, goal_cases)
case (2 i xs) then have "len m i i xs < 𝟭" by auto
with 2 show ?case by auto
next
case (1 i xs j)
then have "len m i j (rem_cycles i j xs) > len m i j xs" by auto
from negative_cycle_dest[OF this]
obtain i' ys where ys: "i' ∈ set (i # j # xs)" "len m i' i' ys < 𝟭" "set ys ⊆ set xs" by blast
from ys(1) 1(2-4) show ?case
proof (auto, goal_cases)
case 1
with ys(2,3) show ?case by auto
next
case 2
with ys(2,3) show ?case by auto
next
case 3
with ‹?k ≤ n› have "i' ≤ n" unfolding cycle_free_up_to_def by auto
with 3 ys(2,3) show ?case by auto
qed
qed
then obtain a as where a_as: "a ≤ n ∧ len m a a as < 𝟭 ∧ set as ⊆ {0..?k}" by auto
with negative_len_shortest[of as "length as" m a] obtain j xs where j_xs:
"distinct (j # xs) ∧ len m j j xs < 𝟭 ∧ j ∈ set (a # as) ∧ set xs ⊆ set as" by auto
with a_as ‹?k ≤ n› have cyc: "j ≤ n" "set xs ⊆ {0..?k}" "len m j j xs < 𝟭" "distinct (j # xs)"
by auto
{ assume "?k > 0"
then have "?k - 1 < ?k" by simp
with * have **:"cycle_free_up_to m (?k - 1) n" by blast
have "?k ∈ set xs"
proof (rule ccontr, goal_cases)
case 1
with ‹set xs ⊆ {0..?k}› nat_upto_subs_top_removal have "set xs ⊆ {0..?k-1}" by auto
from cycle_free_up_to_loop_dest[OF ‹j ≤ n› this ‹cycle_free_up_to m (?k - 1) n›] cyc(3)
show ?case by auto
qed
with cyc(4) have "j ≠ ?k" by auto
from ‹?k ∈ set xs› obtain ys zs where "xs = ys @ ?k # zs" by (meson split_list)
with ‹distinct (j # xs)›
have xs: "xs = ys @ ?k # zs" "distinct ys" "distinct zs" "?k ∉ set ys" "?k ∉ set zs"
"j ∉ set ys" "j ∉ set zs" by auto
from xs(1,4) ‹set xs ⊆ {0..?k}› nat_upto_subs_top_removal have ys: "set ys ⊆ {0..?k-1}" by auto
from xs(1,5) ‹set xs ⊆ {0..?k}› nat_upto_subs_top_removal have zs: "set zs ⊆ {0..?k-1}" by auto
have "D m j ?k (?k - 1) = fw m n (?k - 1) n n j ?k"
using ‹?k ≤ n› ‹j ≤ n› fw_shortest_path_up_to[OF **, of j n ?k n] by auto
moreover have "D m ?k j (?k - 1) = fw m n (?k - 1) n n ?k j"
using ‹?k ≤ n› ‹j ≤ n› fw_shortest_path_up_to[OF **, of ?k n j n] by auto
ultimately have "fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j ≤ len m j ?k ys + len m ?k j zs"
using D_not_diag_le'[OF zs(1) xs(5,7,3), of m]
D_not_diag_le'[OF ys(1) xs(6,4,2), of m] by (auto simp: add_mono)
then have neg: "fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j < 𝟭"
using xs(1) ‹len m j j xs < 𝟭› len_comp by auto
have "fw m n ?k j j j j ≤ fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
proof (cases "j = 0")
case True
with‹?k > 0› fw.simps(2)[of m n "?k - 1"]
have "fw m n ?k j j = fw_upd (fw m n (?k - 1) n n) ?k j j" by auto
then have "fw m n ?k j j j j ≤ fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
by (simp add: fw_upd_def upd_def)
then show ?thesis by auto
next
case False
with fw.simps(4)[of m n ?k j "j - 1"]
have "fw m n ?k j j = fw_upd (fw m n ?k j (j -1)) ?k j j" by simp
then have *: "fw m n ?k j j j j ≤ fw m n ?k j (j -1) j ?k + fw m n ?k j (j -1) ?k j"
by (simp add: fw_upd_def upd_def)
have "j - 1 < n" using ‹j ≤ n› False by auto
then have "fw m n ?k j (j -1) j ?k ≤ fw m n (?k - 1) n n j ?k"
using fw_Suc[of j n ?k j "j - 1" m "?k - 1"] ‹j ≤ n› ‹?k ≤ n› ‹?k > 0› by auto
moreover have "fw m n ?k j (j -1) ?k j ≤ fw m n (?k - 1) n n ?k j"
using fw_Suc[of ?k n j j "j - 1" m "?k - 1"] ‹j ≤ n› ‹?k ≤ n› ‹?k > 0› by auto
ultimately have "fw m n ?k j j j j ≤ fw m n (?k - 1) n n j ?k + fw m n (?k - 1) n n ?k j"
using * add_mono by fastforce
then show ?thesis by auto
qed
with neg have "fw m n ?k j j j j < 𝟭" by auto
moreover have "fw m n n n n j j ≤ fw m n ?k j j j j" using fw_invariant ‹j≤n› ‹?k ≤ n› by auto
ultimately have "fw m n n n n j j < 𝟭" using neg by auto
with ‹j≤n› have ?thesis by auto
}
moreover
{ assume "?k = 0"
with cyc(2,4) have "xs = [] ∨ xs = [0]"
apply safe
apply (case_tac xs)
apply fastforce
apply (rename_tac ys)
apply (case_tac ys)
apply auto
done
then have ?thesis
proof
assume "xs = []"
with cyc have "m j j < 𝟭" by auto
with fw_mono[of n n n j j m n] ‹j ≤ n› have "fw m n n n n j j < 𝟭" by auto
with ‹j ≤ n› show ?thesis by auto
next
assume xs: "xs = [0]"
with cyc have "m j 0 + m 0 j < 𝟭" by auto
then have "fw m n 0 j j j j < 𝟭"
proof (cases "j = 0", goal_cases)
case 1
have "m j j < 𝟭"
proof (rule ccontr)
assume "¬ m j j < 𝟭"
with 1 have "m 0 0 ≥ 𝟭" by simp
with add_mono have "m 0 0 + m 0 0 ≥ 𝟭" by fastforce
with 1 show False by simp
qed
with fw_mono[of j n j j j m 0] ‹j ≤ n› show ?thesis by auto
next
case 2
with fw.simps(4)[of m n 0 j "j - 1"]
have "fw m n 0 j j = fw_upd (fw m n 0 j (j - 1)) 0 j j" by simp
then have "fw m n 0 j j j j ≤ fw m n 0 j (j - 1) j 0 + fw m n 0 j (j - 1) 0 j"
by (simp add: fw_upd_def upd_def)
also have "… ≤ m j 0 + m 0 j" using ‹j ≤ n› add_mono fw_mono by auto
finally show ?thesis using 2 by auto
qed
then have "fw m n 0 n n j j < 𝟭" by (metis cyc(1) less_or_eq_imp_le single_iteration_inv)
with fw_invariant[of 0 n n n n n n m j j] ‹j ≤ n› have "fw m n n n n j j < 𝟭" by auto
with ‹j ≤ n› show ?thesis by blast
qed
}
ultimately show ?thesis by auto
qed
end
end
Theory Timed_Automata
theory Timed_Automata
imports Main
begin
chapter ‹Basic Definitions and Semantics›
section ‹Time›
class time = linordered_ab_group_add +
assumes dense: "x < y ⟹ ∃z. x < z ∧ z < y"
assumes non_trivial: "∃ x. x ≠ 0"
begin
lemma non_trivial_neg: "∃ x. x < 0"
proof -
from non_trivial obtain x where "x ≠ 0" by auto
then show ?thesis
proof (cases "x < 0", auto, goal_cases)
case 1
then have "x > 0" by auto
then have "(-x) < 0" by auto
then show ?case by blast
qed
qed
end
datatype ('c, 't :: time) cconstraint =
AND "('c, 't) cconstraint" "('c, 't) cconstraint" |
LT 'c 't |
LE 'c 't |
EQ 'c 't |
GT 'c 't |
GE 'c 't
section ‹Syntactic Definition›
text ‹
For an informal description of timed automata we refer to Bengtsson and Yi \cite{BengtssonY03}.
We define a timed automaton ‹A›
›
type_synonym
('c, 'time, 's) invassn = "'s ⇒ ('c, 'time) cconstraint"
type_synonym
('a, 'c, 'time, 's) transition = "'s * ('c, 'time) cconstraint * 'a * 'c list * 's"
type_synonym
('a, 'c, 'time, 's) ta = "('a, 'c, 'time, 's) transition set * ('c, 'time, 's) invassn"
definition trans_of :: "('a, 'c, 'time, 's) ta ⇒ ('a, 'c, 'time, 's) transition set" where
"trans_of ≡ fst"
definition inv_of :: "('a, 'c, 'time, 's) ta ⇒ ('c, 'time, 's) invassn" where
"inv_of ≡ snd"
abbreviation transition ::
"('a, 'c, 'time, 's) ta ⇒ 's ⇒ ('c, 'time) cconstraint ⇒ 'a ⇒ 'c list ⇒ 's ⇒ bool"
("_ ⊢ _ ⟶⇗_,_,_⇖ _" [61,61,61,61,61,61] 61) where
"(A ⊢ l ⟶⇗g,a,r⇖ l') ≡ (l,g,a,r,l') ∈ trans_of A"
subsection ‹Collecting Information About Clocks›
fun collect_clks :: "('c, 't :: time) cconstraint ⇒ 'c set"
where
"collect_clks (AND cc1 cc2) = collect_clks cc1 ∪ collect_clks cc2" |
"collect_clks (LT c _) = {c}" |
"collect_clks (LE c _) = {c}" |
"collect_clks (EQ c _) = {c}" |
"collect_clks (GE c _) = {c}" |
"collect_clks (GT c _) = {c}"
fun collect_clock_pairs :: "('c, 't :: time) cconstraint ⇒ ('c * 't) set"
where
"collect_clock_pairs (LT x m) = {(x, m)}" |
"collect_clock_pairs (LE x m) = {(x, m)}" |
"collect_clock_pairs (EQ x m) = {(x, m)}" |
"collect_clock_pairs (GE x m) = {(x, m)}" |
"collect_clock_pairs (GT x m) = {(x, m)}" |
"collect_clock_pairs (AND cc1 cc2) = (collect_clock_pairs cc1 ∪ collect_clock_pairs cc2)"
definition collect_clkt :: "('a, 'c, 't::time, 's) transition set ⇒ ('c *'t) set"
where
"collect_clkt S = ⋃ {collect_clock_pairs (fst (snd t)) | t . t ∈ S}"
definition collect_clki :: "('c, 't :: time, 's) invassn ⇒ ('c *'t) set"
where
"collect_clki I = ⋃ {collect_clock_pairs (I x) | x. True}"
definition clkp_set :: "('a, 'c, 't :: time, 's) ta ⇒ ('c *'t) set"
where
"clkp_set A = collect_clki (inv_of A) ∪ collect_clkt (trans_of A)"
definition collect_clkvt :: "('a, 'c, 't::time, 's) transition set ⇒ 'c set"
where
"collect_clkvt S = ⋃ {set ((fst o snd o snd o snd) t) | t . t ∈ S}"
abbreviation clk_set where "clk_set A ≡ fst ` clkp_set A ∪ collect_clkvt (trans_of A)"
inductive valid_abstraction
where
"⟦∀(x,m) ∈ clkp_set A. m ≤ k x ∧ x ∈ X ∧ m ∈ ℕ; collect_clkvt (trans_of A) ⊆ X; finite X⟧
⟹ valid_abstraction A X k"
section ‹Operational Semantics›
type_synonym ('c, 't) cval = "'c ⇒ 't"
definition cval_add :: "('c,'t) cval ⇒ 't::time ⇒ ('c,'t) cval" (infixr "⊕" 64)
where
"u ⊕ d = (λ x. u x + d)"
inductive clock_val :: "('c, 't) cval ⇒ ('c, 't::time) cconstraint ⇒ bool" ("_ ⊢ _" [62, 62] 62)
where
"⟦u ⊢ cc1; u ⊢ cc2⟧ ⟹ u ⊢ AND cc1 cc2" |
"⟦u c < d⟧ ⟹ u ⊢ LT c d" |
"⟦u c ≤ d⟧ ⟹ u ⊢ LE c d" |
"⟦u c = d⟧ ⟹ u ⊢ EQ c d" |
"⟦u c ≥ d⟧ ⟹ u ⊢ GE c d" |
"⟦u c > d⟧ ⟹ u ⊢ GT c d"
declare clock_val.intros[intro]
inductive_cases[elim!]: "u ⊢ AND cc1 cc2"
inductive_cases[elim!]: "u ⊢ LT c d"
inductive_cases[elim!]: "u ⊢ LE c d"
inductive_cases[elim!]: "u ⊢ EQ c d"
inductive_cases[elim!]: "u ⊢ GE c d"
inductive_cases[elim!]: "u ⊢ GT c d"
fun clock_set :: "'c list ⇒ 't::time ⇒ ('c,'t) cval ⇒ ('c,'t) cval"
where
"clock_set [] _ u = u" |
"clock_set (c#cs) t u = (clock_set cs t u)(c:=t)"
abbreviation clock_set_abbrv :: "'c list ⇒ 't::time ⇒ ('c,'t) cval ⇒ ('c,'t) cval"
("[_→_]_" [65,65,65] 65)
where
"[r → t]u ≡ clock_set r t u"
inductive step_t ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, 't) cval ⇒ ('t::time) ⇒ 's ⇒ ('c, 't) cval ⇒ bool"
("_ ⊢ ⟨_, _⟩ →⇗_⇖ ⟨_, _⟩" [61,61,61] 61)
where
"⟦u ⊢ inv_of A l; u ⊕ d ⊢ inv_of A l; d ≥ 0⟧ ⟹ A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l, u ⊕ d⟩"
declare step_t.intros[intro!]
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩"
lemma step_t_determinacy1:
"A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩ ⟹ A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l'',u''⟩ ⟹ l' = l''"
by auto
lemma step_t_determinacy2:
"A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩ ⟹ A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l'',u''⟩ ⟹ u' = u''"
by auto
lemma step_t_cont1:
"d ≥ 0 ⟹ e ≥ 0 ⟹ A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩ ⟹ A ⊢ ⟨l', u'⟩ →⇗e⇖ ⟨l'',u''⟩
⟹ A ⊢ ⟨l, u⟩ →⇗d+e⇖ ⟨l'',u''⟩"
proof -
assume A: "d ≥ 0" "e ≥ 0" "A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩" "A ⊢ ⟨l', u'⟩ →⇗e⇖ ⟨l'',u''⟩"
hence "u' = (u ⊕ d)" "u'' = (u' ⊕ e)" by auto
hence "u'' = (u ⊕ (d + e))" unfolding cval_add_def by auto
with A show ?thesis by auto
qed
inductive step_a ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, ('t::time)) cval ⇒ 'a ⇒ 's ⇒ ('c, 't) cval ⇒ bool"
("_ ⊢ ⟨_, _⟩ →⇘_⇙ ⟨_, _⟩" [61,61,61] 61)
where
"⟦A ⊢ l ⟶⇗g,a,r⇖ l'; u ⊢ g; u' ⊢ inv_of A l'; u' = [r → 0]u⟧ ⟹ (A ⊢ ⟨l, u⟩ →⇘a⇙ ⟨l', u'⟩)"
inductive step ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, ('t::time)) cval ⇒ 's ⇒ ('c, 't) cval ⇒ bool"
("_ ⊢ ⟨_, _⟩ → ⟨_,_⟩" [61,61,61] 61)
where
step_a: "A ⊢ ⟨l, u⟩ →⇘a⇙ ⟨l',u'⟩ ⟹ (A ⊢ ⟨l, u⟩ → ⟨l',u'⟩)" |
step_t: "A ⊢ ⟨l, u⟩ →⇗d⇖ ⟨l',u'⟩ ⟹ (A ⊢ ⟨l, u⟩ → ⟨l',u'⟩)"
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ → ⟨l',u'⟩"
declare step.intros[intro]
inductive
steps :: "('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, ('t::time)) cval ⇒ 's ⇒ ('c, 't) cval ⇒ bool"
("_ ⊢ ⟨_, _⟩ →* ⟨_, _⟩" [61,61,61] 61)
where
refl: "A ⊢ ⟨l, u⟩ →* ⟨l, u⟩" |
step: "A ⊢ ⟨l, u⟩ → ⟨l', u'⟩ ⟹ A ⊢ ⟨l', u'⟩ →* ⟨l'', u''⟩ ⟹ A ⊢ ⟨l, u⟩ →* ⟨l'', u''⟩"
declare steps.intros[intro]
section ‹Zone Semantics›
type_synonym ('c, 't) zone = "('c, 't) cval set"
definition zone_delay :: "('c, ('t::time)) zone ⇒ ('c, 't) zone"
("_⇧↑" [71] 71)
where
"Z⇧↑ = {u ⊕ d|u d. u ∈ Z ∧ d ≥ (0::'t)}"
definition zone_set :: "('c, 't::time) zone ⇒ 'c list ⇒ ('c, 't) zone"
("_⇘_ → 0⇙" [71] 71)
where
"zone_set Z r = {[r → (0::'t)]u | u . u ∈ Z}"
inductive step_z ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, ('t::time)) zone ⇒ 's ⇒ ('c, 't) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝ ⟨_, _⟩" [61,61,61] 61)
where
step_t_z: "A ⊢ ⟨l, Z⟩ ↝ ⟨l, (Z ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}⟩" |
step_a_z: "⟦A ⊢ l ⟶⇗g,a,r⇖ l'⟧
⟹ (A ⊢ ⟨l, Z⟩ ↝ ⟨l', zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}⟩ )"
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ ↝ ⟨l', u'⟩"
declare step_z.intros[intro]
lemma step_z_sound:
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ (∀ u' ∈ Z'. ∃ u ∈ Z. A ⊢ ⟨l, u⟩ → ⟨l',u'⟩)"
proof (induction rule: step_z.induct, goal_cases)
case 1 thus ?case unfolding zone_delay_def by blast
next
case (2 A l g a r l' Z)
show ?case
proof
fix u' assume "u' ∈ zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
then obtain u where
"u ⊢ g" "u' ⊢ inv_of A l'" "u' = [r→0]u" "u ∈ Z"
unfolding zone_set_def by auto
with step_a.intros[OF 2 this(1-3)] show "∃u∈Z. A ⊢ ⟨l, u⟩ → ⟨l',u'⟩" by fast
qed
qed
lemma step_z_complete:
"A ⊢ ⟨l, u⟩ → ⟨l', u'⟩ ⟹ u ∈ Z ⟹ ∃ Z'. A ⊢ ⟨l, Z⟩ ↝ ⟨l', Z'⟩ ∧ u' ∈ Z'"
proof (induction rule: step.induct, goal_cases)
case (1 A l u a l' u')
then obtain g r
where u': "u' = [r→0]u" "A ⊢ l ⟶⇗g,a,r⇖ l'" "u ⊢ g" "[r→0]u ⊢ inv_of A l'"
by (cases rule: step_a.cases) auto
hence "u' ∈ zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
unfolding zone_set_def using ‹u ∈ Z› by blast
with u'(1,2) show ?case by blast
next
case (2 A l u d l' u')
hence u': "u' = (u ⊕ d)" "u ⊢ inv_of A l" "u ⊕ d ⊢ inv_of A l" "0 ≤ d" and "l = l'" by auto
with u' ‹u ∈ Z› have
"u' ∈ {u'' ⊕ d |u'' d. u'' ∈ Z ∩ {u. u ⊢ inv_of A l} ∧ 0 ≤ d} ∩ {u. u ⊢ inv_of A l}"
by fastforce
thus ?case using ‹l = l'› step_t_z[unfolded zone_delay_def, of A l] by blast
qed
text ‹
Corresponds to version in old papers --
not strong enough for inductive proof over transitive closure relation.
›
lemma step_z_complete1:
"A ⊢ ⟨l, u⟩ → ⟨l', u'⟩ ⟹ ∃ Z. A ⊢ ⟨l, {u}⟩ ↝ ⟨l', Z⟩ ∧ u' ∈ Z"
proof (induction rule: step.induct, goal_cases)
case (1 A l u a l' u')
then obtain g r
where u': "u' = [r→0]u" "A ⊢ l ⟶⇗g,a,r⇖ l'" "u ⊢ g" "[r→0]u ⊢ inv_of A l'"
by (cases rule: step_a.cases) auto
hence "{[r→0]u} = zone_set ({u} ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
unfolding zone_set_def by blast
with u'(1,2) show ?case by auto
next
case (2 A l u d l' u')
hence u': "u' = (u ⊕ d)" "u ⊢ inv_of A l" "u ⊕ d ⊢ inv_of A l" "0 ≤ d" and "l = l'" by auto
hence "{u} = {u} ∩ {u''. u'' ⊢ inv_of A l}" by fastforce
with u'(1) have "{u'} = {u'' ⊕ d |u''. u'' ∈ {u} ∩ {u''. u'' ⊢ inv_of A l}}" by fastforce
with u' have
"u' ∈ {u'' ⊕ d |u'' d. u'' ∈ {u} ∩ {u. u ⊢ inv_of A l} ∧ 0 ≤ d} ∩ {u. u ⊢ inv_of A l}"
by fastforce
thus ?case using ‹l = l'› step_t_z[unfolded zone_delay_def, of A l "{u}"] by blast
qed
text ‹
Easier proof.
›
lemma step_z_complete2:
"A ⊢ ⟨l, u⟩ → ⟨l', u'⟩ ⟹ ∃ Z. A ⊢ ⟨l, {u}⟩ ↝ ⟨l', Z⟩ ∧ u' ∈ Z"
using step_z_complete by fast
inductive
steps_z :: "('a, 'c, 't, 's) ta ⇒ 's ⇒ ('c, ('t::time)) zone ⇒ 's ⇒ ('c, 't) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝* ⟨_, _⟩" [61,61,61] 61)
where
refl: "A ⊢ ⟨l, Z⟩ ↝* ⟨l, Z⟩" |
step: "A ⊢ ⟨l, Z⟩ ↝ ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝* ⟨l'', Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝* ⟨l'', Z''⟩"
declare steps_z.intros[intro]
lemma steps_z_sound:
"A ⊢ ⟨l, Z⟩ ↝* ⟨l', Z'⟩ ⟹ u' ∈ Z' ⟹ ∃ u ∈ Z. A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩"
proof (induction A l _ l' _ arbitrary: rule: steps_z.induct, goal_cases)
case refl thus ?case by fast
next
case (step A l Z l' Z' l'' Z'')
then obtain u'' where u'': "A ⊢ ⟨l', u''⟩ →* ⟨l'',u'⟩" "u'' ∈ Z'" by auto
then obtain u where "u ∈ Z" "A ⊢ ⟨l, u⟩ → ⟨l',u''⟩" using step_z_sound[OF step(1)] by blast
with u'' show ?case by blast
qed
lemma steps_z_complete:
"A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩ ⟹ u ∈ Z ⟹ ∃ Z'. A ⊢ ⟨l, Z⟩ ↝* ⟨l', Z'⟩ ∧ u' ∈ Z'"
proof (induction arbitrary: Z rule: steps.induct)
case refl thus ?case by auto
next
case (step A l u l' u' l'' u'' Z)
from step_z_complete[OF this(1,4)] obtain Z' where Z': "A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩" "u' ∈ Z'" by auto
then obtain Z'' where "A ⊢ ⟨l', Z'⟩ ↝* ⟨l'',Z''⟩" "u'' ∈ Z''" using step by metis
with Z' show ?case by blast
qed
end
Theory DBM
theory DBM
imports Floyd_Warshall Timed_Automata
begin
chapter ‹Difference Bound Matrices›
section ‹Definitions›
text ‹
Difference Bound Matrices (DBMs) constrain differences of clocks
(or more precisely, the difference of values assigned to individual clocks by a valuation).
The possible constraints are given by the following datatype:
›
datatype ('t::time) DBMEntry = Le 't | Lt 't | INF ("∞")
text ‹\noindent This yields a simple definition of DBMs:›
type_synonym 't DBM = "nat ⇒ nat ⇒ 't DBMEntry"
text ‹\noindent
To relate clocks with rows and columns of
a DBM, we use a clock numbering ‹v› of type @{typ "'c ⇒ nat"} to map clocks to indices.
DBMs will regularly be accompanied by a natural number $n$,
which designates the number of clocks constrained by the matrix.
To be able to represent the full set of clock constraints with DBMs, we add an imaginary
clock ‹𝟬›, which shall be assigned to 0 in every valuation.
In the following predicate we explicitly keep track of ‹𝟬›.
›
inductive dbm_entry_val :: "('c, 't) cval ⇒ 'c option ⇒ 'c option ⇒ ('t::time) DBMEntry ⇒ bool"
where
"u r ≤ d ⟹ dbm_entry_val u (Some r) None (Le d)" |
"-u c ≤ d ⟹ dbm_entry_val u None (Some c) (Le d)" |
"u r < d ⟹ dbm_entry_val u (Some r) None (Lt d)" |
"-u c < d ⟹ dbm_entry_val u None (Some c) (Lt d)" |
"u r - u c ≤ d ⟹ dbm_entry_val u (Some r) (Some c) (Le d)" |
"u r - u c < d ⟹ dbm_entry_val u (Some r) (Some c) (Lt d)" |
"dbm_entry_val _ _ _ ∞"
declare dbm_entry_val.intros[intro]
inductive_cases[elim!]: "dbm_entry_val u None (Some c) (Le d)"
inductive_cases[elim!]: "dbm_entry_val u (Some c) None (Le d)"
inductive_cases[elim!]: "dbm_entry_val u None (Some c) (Lt d)"
inductive_cases[elim!]: "dbm_entry_val u (Some c) None (Lt d)"
inductive_cases[elim!]: "dbm_entry_val u (Some r) (Some c) (Le d)"
inductive_cases[elim!]: "dbm_entry_val u (Some r) (Some c) (Lt d)"
fun dbm_entry_bound :: "('t::time) DBMEntry ⇒ 't"
where
"dbm_entry_bound (Le t) = t" |
"dbm_entry_bound (Lt t) = t" |
"dbm_entry_bound ∞ = 0"
inductive dbm_lt :: "('t::time) DBMEntry ⇒ 't DBMEntry ⇒ bool"
("_ ≺ _" [51, 51] 50)
where
"dbm_lt (Lt _) ∞" |
"dbm_lt (Le _) ∞" |
"a < b ⟹ dbm_lt (Le a) (Le b)" |
"a < b ⟹ dbm_lt (Le a) (Lt b)" |
"a ≤ b ⟹ dbm_lt (Lt a) (Le b)" |
"a < b ⟹ dbm_lt (Lt a) (Lt b)"
declare dbm_lt.intros[intro]
definition dbm_le :: "('t::time) DBMEntry ⇒ 't DBMEntry ⇒ bool"
("_ ≼ _" [51, 51] 50)
where
"dbm_le a b ≡ (a ≺ b) ∨ a = b"
text ‹
Now a valuation is contained in the zone represented by a DBM if it fulfills all individual
constraints:
›
definition DBM_val_bounded :: "('c ⇒ nat) ⇒ ('c, 't) cval ⇒ ('t::time) DBM ⇒ nat ⇒ bool"
where
"DBM_val_bounded v u m n ≡ Le 0 ≼ m 0 0 ∧
(∀ c. v c ≤ n ⟶ (dbm_entry_val u None (Some c) (m 0 (v c))
∧ dbm_entry_val u (Some c) None (m (v c) 0)))
∧ (∀ c1 c2. v c1 ≤ n ∧ v c2 ≤ n ⟶ dbm_entry_val u (Some c1) (Some c2) (m (v c1) (v c2)))"
abbreviation DBM_val_bounded_abbrev ::
"('c, 't) cval ⇒ ('c ⇒ nat) ⇒ nat ⇒ ('t::time) DBM ⇒ bool"
("_ ⊢⇘_,_⇙ _")
where
"u ⊢⇘v,n⇙ M ≡ DBM_val_bounded v u M n"
abbreviation
"dmin a b ≡ if a ≺ b then a else b"
lemma dbm_le_dbm_min:
"a ≼ b ⟹ a = dmin a b" unfolding dbm_le_def
by auto
lemma dbm_lt_asym:
assumes "e ≺ f"
shows "~ f ≺ e"
using assms
proof (safe, cases e f rule: dbm_lt.cases, goal_cases)
case 1 from this(2) show ?case using 1(3-) by (cases f e rule: dbm_lt.cases) auto
next
case 2 from this(2) show ?case using 2(3-) by (cases f e rule: dbm_lt.cases) auto
next
case 3 from this(2) show ?case using 3(3-) by (cases f e rule: dbm_lt.cases) auto
next
case 4 from this(2) show ?case using 4(3-) by (cases f e rule: dbm_lt.cases) auto
next
case 5 from this(2) show ?case using 5(3-) by (cases f e rule: dbm_lt.cases) auto
next
case 6 from this(2) show ?case using 6(3-) by (cases f e rule: dbm_lt.cases) auto
qed
lemma dbm_le_dbm_min2:
"a ≼ b ⟹ a = dmin b a"
using dbm_lt_asym by (auto simp: dbm_le_def)
lemma dmb_le_dbm_entry_bound_inf:
"a ≼ b ⟹ a = ∞ ⟹ b = ∞"
apply (auto simp: dbm_le_def)
apply (cases rule: dbm_lt.cases)
by auto
lemma dbm_not_lt_eq: "¬ a ≺ b ⟹ ¬ b ≺ a ⟹ a = b"
apply (cases a)
apply (cases b, fastforce+)+
done
lemma dbm_not_lt_impl: "¬ a ≺ b ⟹ b ≺ a ∨ a = b" using dbm_not_lt_eq by auto
lemma "dmin a b = dmin b a"
proof (cases "a ≺ b")
case True thus ?thesis by (simp add: dbm_lt_asym)
next
case False thus ?thesis by (simp add: dbm_not_lt_eq)
qed
lemma dbm_lt_trans: "a ≺ b ⟹ b ≺ c ⟹ a ≺ c"
proof (cases a b rule: dbm_lt.cases, goal_cases)
case 1 thus ?case by simp
next
case 2 from this(2-) show ?case by (cases rule: dbm_lt.cases) simp+
next
case 3 from this(2-) show ?case by (cases rule: dbm_lt.cases) simp+
next
case 4 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
case 5 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
case 6 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
next
case 7 from this(2-) show ?case by (cases rule: dbm_lt.cases) auto
qed
lemma aux_3: "¬ a ≺ b ⟹ ¬ b ≺ c ⟹ a ≺ c ⟹ c = a"
proof goal_cases
case 1 thus ?case
proof (cases "c ≺ b")
case True
with ‹a ≺ c› have "a ≺ b" by (rule dbm_lt_trans)
thus ?thesis using 1 by auto
next
case False thus ?thesis using dbm_not_lt_eq 1 by auto
qed
qed
inductive_cases[elim!]: "∞ ≺ x"
lemma dbm_lt_asymmetric[simp]: "x ≺ y ⟹ y ≺ x ⟹ False"
by (cases x y rule: dbm_lt.cases) (auto elim: dbm_lt.cases)
lemma le_dbm_le: "Le a ≼ Le b ⟹ a ≤ b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)
lemma le_dbm_lt: "Le a ≼ Lt b ⟹ a < b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)
lemma lt_dbm_le: "Lt a ≼ Le b ⟹ a ≤ b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)
lemma lt_dbm_lt: "Lt a ≼ Lt b ⟹ a ≤ b" unfolding dbm_le_def by (auto elim: dbm_lt.cases)
lemma not_dbm_le_le_impl: "¬ Le a ≺ Le b ⟹ a ≥ b" by (metis dbm_lt.intros(3) not_less)
lemma not_dbm_lt_le_impl: "¬ Lt a ≺ Le b ⟹ a > b" by (metis dbm_lt.intros(5) not_less)
lemma not_dbm_lt_lt_impl: "¬ Lt a ≺ Lt b ⟹ a ≥ b" by (metis dbm_lt.intros(6) not_less)
lemma not_dbm_le_lt_impl: "¬ Le a ≺ Lt b ⟹ a ≥ b" by (metis dbm_lt.intros(4) not_less)
fun dbm_add :: "('t::time) DBMEntry ⇒ 't DBMEntry ⇒ 't DBMEntry" (infixl "⊗" 70)
where
"dbm_add ∞ _ = ∞" |
"dbm_add _ ∞ = ∞" |
"dbm_add (Le a) (Le b) = (Le (a+b))" |
"dbm_add (Le a) (Lt b) = (Lt (a+b))" |
"dbm_add (Lt a) (Le b) = (Lt (a+b))" |
"dbm_add (Lt a) (Lt b) = (Lt (a+b))"
thm dbm_add.simps
lemma aux_4: "x ≺ y ⟹ ¬ dbm_add x z ≺ dbm_add y z ⟹ dbm_add x z = dbm_add y z"
by (cases x y rule: dbm_lt.cases) ((cases z), auto)+
lemma aux_5: "¬ x ≺ y ⟹ dbm_add x z ≺ dbm_add y z ⟹ dbm_add y z = dbm_add x z"
proof -
assume lt: "dbm_add x z ≺ dbm_add y z" "¬ x ≺ y"
hence "x = y ∨ y ≺ x" by (auto simp: dbm_not_lt_eq)
thus ?thesis
proof
assume "x = y" thus ?thesis by simp
next
assume "y ≺ x"
thus ?thesis
proof (cases y x rule: dbm_lt.cases, goal_cases)
case 1 thus ?case using lt by auto
next
case 2 thus ?case using lt by auto
next
case 3 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 4 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 5 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 6 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
qed
qed
qed
lemma aux_42: "x ≺ y ⟹ ¬ dbm_add z x ≺ dbm_add z y ⟹ dbm_add z x = dbm_add z y"
by (cases x y rule: dbm_lt.cases) ((cases z), auto)+
lemma aux_52: "¬ x ≺ y ⟹ dbm_add z x ≺ dbm_add z y ⟹ dbm_add z y = dbm_add z x"
proof -
assume lt: "dbm_add z x ≺ dbm_add z y" "¬ x ≺ y"
hence "x = y ∨ y ≺ x" by (auto simp: dbm_not_lt_eq)
thus ?thesis
proof
assume "x = y" thus ?thesis by simp
next
assume "y ≺ x"
thus ?thesis
proof (cases y x rule: dbm_lt.cases, goal_cases)
case 1 thus ?case using lt by (cases z) fastforce+
next
case 2 thus ?case using lt by (cases z) fastforce+
next
case 3 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 4 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 5 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
next
case 6 thus ?case using dbm_lt_asymmetric lt(1) by (cases z) fastforce+
qed
qed
qed
lemma dbm_add_not_inf:
"a ≠ ∞ ⟹ b ≠ ∞ ⟹ dbm_add a b ≠ ∞"
by (cases a, auto, cases b, auto, cases b, auto)
lemma dbm_le_not_inf:
"a ≼ b ⟹ b ≠ ∞ ⟹ a ≠ ∞"
by (cases "a = b") (auto simp: dbm_le_def)
section ‹DBM Entries Form a Linearly Ordered Abelian Monoid›
instantiation DBMEntry :: (time) linorder
begin
definition less_eq: "(≤) ≡ dbm_le"
definition less: "(<) = dbm_lt"
instance
proof ((standard; unfold less less_eq), goal_cases)
case 1 thus ?case unfolding dbm_le_def using dbm_lt_asymmetric by auto
next
case 2 thus ?case by (simp add: dbm_le_def)
next
case 3 thus ?case unfolding dbm_le_def using dbm_lt_trans by auto
next
case 4 thus ?case unfolding dbm_le_def using dbm_lt_asymmetric by auto
next
case 5 thus ?case unfolding dbm_le_def using dbm_not_lt_eq by auto
qed
end
instantiation DBMEntry :: (time) linordered_ab_monoid_add
begin
definition mult: "(+) = dbm_add"
definition neutral: "neutral = Le 0"
instance proof ((standard; unfold mult neutral less less_eq), goal_cases)
case (1 a b c) thus ?case by (cases a; cases b; cases c; auto)
next
case (2 a b) thus ?case by (cases a; cases b) auto
next
case (3 a b c)
thus ?case unfolding dbm_le_def
apply safe
apply (rule dbm_lt.cases)
apply assumption
by (cases c; fastforce)+
next
case (4 x) thus ?case by (cases x) auto
next
case (5 x) thus ?case by (cases x) auto
qed
end
interpretation linordered_monoid: linordered_ab_monoid_add dbm_add dbm_le dbm_lt "Le 0"
apply (standard, fold neutral mult less_eq less)
using add.commute add.commute add_left_mono assoc by auto
lemma Le_Le_dbm_lt_D[dest]: "Le a ≺ Lt b ⟹ a < b" by (cases rule: dbm_lt.cases) auto
lemma Le_Lt_dbm_lt_D[dest]: "Le a ≺ Le b ⟹ a < b" by (cases rule: dbm_lt.cases) auto
lemma Lt_Le_dbm_lt_D[dest]: "Lt a ≺ Le b ⟹ a ≤ b" by (cases rule: dbm_lt.cases) auto
lemma Lt_Lt_dbm_lt_D[dest]: "Lt a ≺ Lt b ⟹ a < b" by (cases rule: dbm_lt.cases) auto
lemma Le_le_LeI[intro]: "a ≤ b ⟹ Le a ≤ Le b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LeI[intro]: "a ≤ b ⟹ Lt a ≤ Le b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LtI[intro]: "a ≤ b ⟹ Lt a ≤ Lt b" unfolding less_eq dbm_le_def by auto
lemma Le_le_LtI[intro]: "a < b ⟹ Le a ≤ Lt b" unfolding less_eq dbm_le_def by auto
lemma Lt_lt_LeI: "x ≤ y ⟹ Lt x < Le y" unfolding less by auto
lemma Le_le_LeD[dest]: "Le a ≤ Le b ⟹ a ≤ b" unfolding dbm_le_def less_eq by auto
lemma Le_le_LtD[dest]: "Le a ≤ Lt b ⟹ a < b" unfolding dbm_le_def less_eq by auto
lemma Lt_le_LeD[dest]: "Lt a ≤ Le b ⟹ a ≤ b" unfolding less_eq dbm_le_def by auto
lemma Lt_le_LtD[dest]: "Lt a ≤ Lt b ⟹ a ≤ b" unfolding less_eq dbm_le_def by auto
lemma inf_not_le_Le[simp]: "∞ ≤ Le x = False" unfolding less_eq dbm_le_def by auto
lemma inf_not_le_Lt[simp]: "∞ ≤ Lt x = False" unfolding less_eq dbm_le_def by auto
lemma inf_not_lt[simp]: "∞ ≺ x = False" by auto
lemma any_le_inf: "x ≤ ∞" by (metis less_eq dmb_le_dbm_entry_bound_inf le_cases)
section ‹Basic Properties of DBMs›
subsection ‹DBMs and Length of Paths›
lemma dbm_entry_val_add_1: "dbm_entry_val u (Some c) (Some d) a ⟹ dbm_entry_val u (Some d) None b
⟹ dbm_entry_val u (Some c) None (dbm_add a b)"
proof (cases a, goal_cases)
case 1 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_semiring(1) apply fastforce
using add_le_less_mono by fastforce
next
case 2 thus ?thesis
apply (cases b)
apply auto
apply (simp add: dbm_entry_val.intros(3) diff_less_eq less_le_trans)
by (metis add_le_less_mono dbm_entry_val.intros(3) diff_add_cancel less_imp_le)
next
case 3 thus ?thesis by (cases b) auto
qed
lemma dbm_entry_val_add_2: "dbm_entry_val u None (Some c) a ⟹ dbm_entry_val u (Some c) (Some d) b
⟹ dbm_entry_val u None (Some d) (dbm_add a b)"
proof (cases a, goal_cases)
case 1 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_semiring(1) apply fastforce
using add_le_less_mono by fastforce
next
case 2 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_field(3) apply fastforce
using add_strict_mono by fastforce
next
case 3 thus ?thesis by (cases b) auto
qed
lemma dbm_entry_val_add_3:
"dbm_entry_val u (Some c) (Some d) a ⟹ dbm_entry_val u (Some d) (Some e) b
⟹ dbm_entry_val u (Some c) (Some e) (dbm_add a b)"
proof (cases a, goal_cases)
case 1 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_semiring(1) apply fastforce
using add_le_less_mono by fastforce
next
case 2 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_field(3) apply fastforce
using add_strict_mono by fastforce
next
case 3 thus ?thesis by (cases b) auto
qed
lemma dbm_entry_val_add_4:
"dbm_entry_val u (Some c) None a ⟹ dbm_entry_val u None (Some d) b
⟹ dbm_entry_val u (Some c) (Some d) (dbm_add a b)"
proof (cases a, goal_cases)
case 1 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_semiring(1) apply fastforce
using add_le_less_mono by fastforce
next
case 2 thus ?thesis
apply (cases b)
apply auto
using add_mono_thms_linordered_field(3) apply fastforce
using add_strict_mono by fastforce
next
case 3 thus ?thesis by (cases b) auto
qed
no_notation dbm_add (infixl "⊗" 70)
lemma DBM_val_bounded_len_1'_aux:
assumes "DBM_val_bounded v u m n" "v c ≤ n" "∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u (Some c) None (len m (v c) 0 vs)" using assms
proof (induction vs arbitrary: c)
case Nil then show ?case unfolding DBM_val_bounded_def by auto
next
case (Cons k vs)
then obtain c' where c': "k > 0" "k ≤ n" "v c' = k" by auto
with Cons have "dbm_entry_val u (Some c') None (len m (v c') 0 vs)" by auto
moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems c'
by (auto simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u (Some c) None (m (v c) (v c') + len m (v c') 0 vs)"
using dbm_entry_val_add_1 unfolding mult by fastforce
with c' show ?case unfolding DBM_val_bounded_def by simp
qed
lemma DBM_val_bounded_len_3'_aux:
"DBM_val_bounded v u m n ⟹ v c ≤ n ⟹ v d ≤ n ⟹ ∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)
⟹ dbm_entry_val u (Some c) (Some d) (len m (v c) (v d) vs)"
proof (induction vs arbitrary: c)
case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
case (Cons k vs)
then obtain c' where c': "k > 0" "k ≤ n" "v c' = k" by auto
with Cons have "dbm_entry_val u (Some c') (Some d) (len m (v c') (v d) vs)" by auto
moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems c'
by (auto simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u (Some c) (Some d) (m (v c) (v c') + len m (v c') (v d) vs)"
using dbm_entry_val_add_3 unfolding mult by fastforce
with c' show ?case unfolding DBM_val_bounded_def by simp
qed
lemma DBM_val_bounded_len_2'_aux:
"DBM_val_bounded v u m n ⟹ v c ≤ n ⟹ ∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)
⟹ dbm_entry_val u None (Some c) (len m 0 (v c) vs)"
proof (cases vs, goal_cases)
case 1 then show ?thesis unfolding DBM_val_bounded_def by auto
next
case (2 k vs)
then obtain c' where c': "k > 0" "k ≤ n" "v c' = k" by auto
with 2 have "dbm_entry_val u (Some c') (Some c) (len m (v c') (v c) vs)"
using DBM_val_bounded_len_3'_aux by auto
moreover have "dbm_entry_val u None (Some c') (m 0 (v c'))"
using 2 c' by (auto simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u None (Some c) (m 0 (v c') + len m (v c') (v c) vs)"
using dbm_entry_val_add_2 unfolding mult by fastforce
with 2(4) c' show ?case unfolding DBM_val_bounded_def by simp
qed
lemma cnt_0_D:
"cnt x xs = 0 ⟹ x ∉ set xs"
apply (induction xs)
apply simp
apply (rename_tac a xs)
apply (case_tac "x = a")
by simp+
lemma cnt_at_most_1_D:
"cnt x (xs @ x # ys) ≤ 1 ⟹ x ∉ set xs ∧ x ∉ set ys"
apply (induction xs)
apply auto[]
using cnt_0_D apply force
apply (rename_tac a xs)
apply (case_tac "a = x")
apply simp
apply simp
done
lemma nat_list_0 [intro]:
"x ∈ set xs ⟹ 0 ∉ set (xs :: nat list) ⟹ x > 0"
by (induction xs) auto
lemma DBM_val_bounded_len':
fixes v
defines "vo ≡ λ k. if k = 0 then None else Some (SOME c. v c = k)"
assumes "DBM_val_bounded v u m n" "cnt 0 (i # j # vs) ≤ 1"
"∀ k ∈ set (i # j # vs). k > 0 ⟶ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u (vo i) (vo j) (len m i j vs)"
proof -
show ?thesis
proof (cases "∀ k ∈ set vs. k > 0")
case True
with assms have *: "∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)" by auto
show ?thesis
proof (cases "i = 0")
case True
then have i: "vo i = None" by (simp add: vo_def)
show ?thesis
proof (cases "j = 0")
case True with assms ‹i = 0› show ?thesis by auto
next
case False
with assms obtain c2 where c2: "j ≤ n" "v c2 = j" "vo j = Some c2"
unfolding vo_def by (fastforce intro: someI)
with ‹i = 0› i DBM_val_bounded_len_2'_aux[OF assms(2) _ *] show ?thesis by auto
qed
next
case False
with assms(4) obtain c1 where c1: "i ≤ n" "v c1 = i" "vo i = Some c1"
unfolding vo_def by (fastforce intro: someI)
show ?thesis
proof (cases "j = 0")
case True
with DBM_val_bounded_len_1'_aux[OF assms(2) _ *] c1 show ?thesis by (auto simp: vo_def)
next
case False
with assms obtain c2 where c2: "j ≤ n" "v c2 = j" "vo j = Some c2"
unfolding vo_def by (fastforce intro: someI)
with c1 DBM_val_bounded_len_3'_aux[OF assms(2) _ _ *] show ?thesis by auto
qed
qed
next
case False
then have "∃ k ∈ set vs. k = 0" by auto
then obtain us ws where vs: "vs = us @ 0 # ws" by (meson split_list_last)
with cnt_at_most_1_D[of 0 "i # j # us"] assms(3) have
"0 ∉ set us" "0 ∉ set ws" "i ≠ 0" "j ≠ 0"
by auto
with vs have vs: "vs = us @ 0 # ws" "∀ k ∈ set us. k > 0" "∀ k ∈ set ws. k > 0" by auto
with assms(4) have v:
"∀k∈set us. 0 < k ∧ k ≤ n ∧ (∃c. v c = k)" "∀k∈set ws. 0 < k ∧ k ≤ n ∧ (∃c. v c = k)"
by auto
from ‹i ≠ 0› ‹j ≠ 0› assms obtain c1 c2 where
c1: "i ≤ n" "v c1 = i" "vo i = Some c1" and c2: "j ≤ n" "v c2 = j" "vo j = Some c2"
unfolding vo_def by (fastforce intro: someI)
with dbm_entry_val_add_4 [OF DBM_val_bounded_len_1'_aux[OF assms(2) _ v(1)] DBM_val_bounded_len_2'_aux[OF assms(2) _ v(2)]]
have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws))" by auto
moreover from vs have "len m (v c1) (v c2) vs = dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws)"
by (simp add: len_comp mult)
ultimately show ?thesis using c1 c2 by auto
qed
qed
lemma DBM_val_bounded_len'1:
fixes v
assumes "DBM_val_bounded v u m n" "0 ∉ set vs" "v c ≤ n"
"∀ k ∈ set vs. k > 0 ⟶ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u (Some c) None (len m (v c) 0 vs)"
using DBM_val_bounded_len_1'_aux[OF assms(1,3)] assms(2,4) by fastforce
lemma DBM_val_bounded_len'2:
fixes v
assumes "DBM_val_bounded v u m n" "0 ∉ set vs" "v c ≤ n"
"∀ k ∈ set vs. k > 0 ⟶ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u None (Some c) (len m 0 (v c) vs)"
using DBM_val_bounded_len_2'_aux[OF assms(1,3)] assms(2,4) by fastforce
lemma DBM_val_bounded_len'3:
fixes v
assumes "DBM_val_bounded v u m n" "cnt 0 vs ≤ 1" "v c1 ≤ n" "v c2 ≤ n"
"∀ k ∈ set vs. k > 0 ⟶ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u (Some c1) (Some c2) (len m (v c1) (v c2) vs)"
proof -
show ?thesis
proof (cases "∀ k ∈ set vs. k > 0")
case True
with assms have "∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)" by auto
with DBM_val_bounded_len_3'_aux[OF assms(1,3,4)] show ?thesis by auto
next
case False
then have "∃ k ∈ set vs. k = 0" by auto
then obtain us ws where vs: "vs = us @ 0 # ws" by (meson split_list_last)
with cnt_at_most_1_D[of 0 "us"] assms(2) have
"0 ∉ set us" "0 ∉ set ws"
by auto
with vs have vs: "vs = us @ 0 # ws" "∀ k ∈ set us. k > 0" "∀ k ∈ set ws. k > 0" by auto
with assms(5) have v:
"∀k∈set us. 0 < k ∧ k ≤ n ∧ (∃c. v c = k)" "∀k∈set ws. 0 < k ∧ k ≤ n ∧ (∃c. v c = k)"
by auto
with dbm_entry_val_add_4 [OF DBM_val_bounded_len_1'_aux[OF assms(1,3) v(1)] DBM_val_bounded_len_2'_aux[OF assms(1,4) v(2)]]
have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws))" by auto
moreover from vs have "len m (v c1) (v c2) vs = dbm_add (len m (v c1) 0 us) (len m 0 (v c2) ws)"
by (simp add: len_comp mult)
ultimately show ?thesis by auto
qed
qed
lemma DBM_val_bounded_len'':
fixes v
defines "vo ≡ λ k. if k = 0 then None else Some (SOME c. v c = k)"
assumes "DBM_val_bounded v u m n" "i ≠ 0 ∨ j ≠ 0"
"∀ k ∈ set (i # j # vs). k > 0 ⟶ k ≤ n ∧ (∃ c. v c = k)"
shows "dbm_entry_val u (vo i) (vo j) (len m i j vs)" using assms
proof (induction "length vs" arbitrary: i vs rule: less_induct)
case less
show ?case
proof (cases "∀ k ∈ set vs. k > 0")
case True
with less.prems have *: "∀ k ∈ set vs. k > 0 ∧ k ≤ n ∧ (∃ c. v c = k)" by auto
show ?thesis
proof (cases "i = 0")
case True
then have i: "vo i = None" by (simp add: vo_def)
show ?thesis
proof (cases "j = 0")
case True with less.prems ‹i = 0› show ?thesis by auto
next
case False
with less.prems obtain c2 where c2: "j ≤ n" "v c2 = j" "vo j = Some c2"
unfolding vo_def by (fastforce intro: someI)
with ‹i = 0› i DBM_val_bounded_len_2'_aux[OF less.prems(1) _ *] show ?thesis by auto
qed
next
case False
with less.prems obtain c1 where c1: "i ≤ n" "v c1 = i" "vo i = Some c1"
unfolding vo_def by (fastforce intro: someI)
show ?thesis
proof (cases "j = 0")
case True
with DBM_val_bounded_len_1'_aux[OF less.prems(1) _ *] c1 show ?thesis by (auto simp: vo_def)
next
case False
with less.prems obtain c2 where c2: "j ≤ n" "v c2 = j" "vo j = Some c2"
unfolding vo_def by (fastforce intro: someI)
with c1 DBM_val_bounded_len_3'_aux[OF less.prems(1) _ _ *] show ?thesis by auto
qed
qed
next
case False
then have "∃ us ws. vs = us @ 0 # ws ∧ (∀ k ∈ set us. k > 0)"
proof (induction vs)
case Nil then show ?case by auto
next
case (Cons x vs)
show ?case
proof (cases "x = 0")
case True then show ?thesis by fastforce
next
case False
with Cons.prems have "¬ (∀a∈set vs. 0 < a)" by auto
from Cons.IH[OF this] obtain us ws where "vs = us @ 0 # ws" "∀a∈set us. 0 < a" by auto
with False have "x # vs = (x # us) @ 0 # ws" "∀a∈set (x # us). 0 < a" by auto
then show ?thesis by blast
qed
qed
then obtain us ws where vs: "vs = us @ 0 # ws" "∀ k ∈ set us. k > 0" by blast
then show ?thesis
oops
lemma DBM_val_bounded_len_1: "DBM_val_bounded v u m n ⟹ v c ≤ n ⟹ ∀ c ∈ set cs. v c ≤ n
⟹ dbm_entry_val u (Some c) None (len m (v c) 0 (map v cs))"
proof (induction cs arbitrary: c)
case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
case (Cons c' cs)
hence "dbm_entry_val u (Some c') None (len m (v c') 0 (map v cs))" by auto
moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems
by (simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u (Some c) None (m (v c) (v c') + len m (v c') 0 (map v cs))"
using dbm_entry_val_add_1 unfolding mult by fastforce
thus ?case unfolding DBM_val_bounded_def by simp
qed
lemma DBM_val_bounded_len_3: "DBM_val_bounded v u m n ⟹ v c ≤ n ⟹ v d ≤ n ⟹ ∀ c ∈ set cs. v c ≤ n
⟹ dbm_entry_val u (Some c) (Some d) (len m (v c) (v d) (map v cs))"
proof (induction cs arbitrary: c)
case Nil thus ?case unfolding DBM_val_bounded_def by auto
next
case (Cons c' cs)
hence "dbm_entry_val u (Some c') (Some d) (len m (v c') (v d) (map v cs))" by auto
moreover have "dbm_entry_val u (Some c) (Some c') (m (v c) (v c'))" using Cons.prems
by (simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u (Some c) (Some d) (m (v c) (v c') + len m (v c') (v d) (map v cs))"
using dbm_entry_val_add_3 unfolding mult by fastforce
thus ?case unfolding DBM_val_bounded_def by simp
qed
lemma DBM_val_bounded_len_2: "DBM_val_bounded v u m n ⟹ v c ≤ n ⟹ ∀ c ∈ set cs. v c ≤ n
⟹ dbm_entry_val u None (Some c) (len m 0 (v c) (map v cs))"
proof (cases cs, goal_cases)
case 1 thus ?thesis unfolding DBM_val_bounded_def by auto
next
case (2 c' cs)
hence "dbm_entry_val u (Some c') (Some c) (len m (v c') (v c) (map v cs))"
using DBM_val_bounded_len_3 by auto
moreover have "dbm_entry_val u None (Some c') (m 0 (v c'))"
using 2 by (simp add: DBM_val_bounded_def)
ultimately have "dbm_entry_val u None (Some c) (m 0 (v c') + len m (v c') (v c) (map v cs))"
using dbm_entry_val_add_2 unfolding mult by fastforce
thus ?case using 2(4) unfolding DBM_val_bounded_def by simp
qed
end
Theory Paths_Cycles
theory Paths_Cycles
imports Floyd_Warshall Timed_Automata
begin
chapter ‹Library for Paths, Arcs and Lengths›
lemma length_eq_distinct:
assumes "set xs = set ys" "distinct xs" "length xs = length ys"
shows "distinct ys"
using assms card_distinct distinct_card by fastforce
section ‹Arcs›
fun arcs :: "nat ⇒ nat ⇒ nat list ⇒ (nat * nat) list" where
"arcs a b [] = [(a,b)]" |
"arcs a b (x # xs) = (a, x) # arcs x b xs"
definition arcs' :: "nat list ⇒ (nat * nat) set" where
"arcs' xs = set (arcs (hd xs) (last xs) (butlast (tl xs)))"
lemma arcs'_decomp:
"length xs > 1 ⟹ (i, j) ∈ arcs' xs ⟹ ∃ zs ys. xs = zs @ i # j # ys"
proof (induction xs)
case Nil thus ?case by auto
next
case (Cons x xs)
then have "length xs > 0" by auto
then obtain y ys where xs: "xs = y # ys" by (metis Suc_length_conv less_imp_Suc_add)
show ?case
proof (cases "(i, j) = (x, y)")
case True
with xs have "x # xs = [] @ i # j # ys" by simp
then show ?thesis by auto
next
case False
then show ?thesis
proof (cases "length ys > 0", goal_cases)
case 2
then have "ys = []" by auto
then have "arcs' (x#xs) = {(x,y)}" using xs by (auto simp add: arcs'_def)
with Cons.prems(2) 2(1) show ?case by auto
next
case True
with xs Cons.prems(2) False have "(i, j) ∈ arcs' xs" by (auto simp add: arcs'_def)
with Cons.IH[OF _ this] True xs obtain zs ys where "xs = zs @ i # j # ys" by auto
then have "x # xs = (x # zs) @ i # j # ys" by simp
then show ?thesis by blast
qed
qed
qed
lemma arcs_decomp_tail:
"arcs j l (ys @ [i]) = arcs j i ys @ [(i, l)]"
by (induction ys arbitrary: j) auto
lemma arcs_decomp: "xs = ys @ y # zs ⟹ arcs x z xs = arcs x y ys @ arcs y z zs"
by (induction ys arbitrary: x xs) simp+
lemma distinct_arcs_ex:
"distinct xs ⟹ i ∉ set xs ⟹ xs ≠ [] ⟹ ∃ a b. a ≠ x ∧ (a,b) ∈ set (arcs i j xs)"
apply (induction xs arbitrary: i)
apply simp
apply (rename_tac a xs i)
apply (case_tac xs)
apply simp
apply metis
by auto
lemma cycle_rotate_2_aux:
"(i, j) ∈ set (arcs a b (xs @ [c])) ⟹ (i,j) ≠ (c,b) ⟹ (i, j) ∈ set (arcs a c xs)"
by (induction xs arbitrary: a) auto
lemma arcs_set_elem1:
assumes "j ≠ k" "k ∈ set (i # xs)"
shows "∃ l. (k, l) ∈ set (arcs i j xs)" using assms
by (induction xs arbitrary: i) auto
lemma arcs_set_elem2:
assumes "i ≠ k" "k ∈ set (j # xs)"
shows "∃ l. (l, k) ∈ set (arcs i j xs)" using assms
proof (induction xs arbitrary: i)
case Nil then show ?case by simp
next
case (Cons x xs)
then show ?case by (cases "k = x") auto
qed
section ‹Length of Paths›
lemmas (in linordered_ab_monoid_add) comm = add.commute
lemma len_add:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
shows "len M i j xs + len M i j xs = len (λi j. M i j + M i j) i j xs"
proof (induction xs arbitrary: i j)
case Nil thus ?case by auto
next
case (Cons x xs)
have "M i x + len M x j xs + (M i x + len M x j xs) = M i x + (len M x j xs + M i x) + len M x j xs"
by (simp add: assoc)
also have "… = M i x + (M i x + len M x j xs) + len M x j xs" by (simp add: comm)
also have "… = (M i x + M i x) + (len M x j xs + len M x j xs)" by (simp add: assoc)
finally have "M i x + len M x j xs + (M i x + len M x j xs)
= (M i x + M i x) + len (λi j. M i j + M i j) x j xs"
using Cons by simp
thus ?case by simp
qed
section ‹Canonical Matrices›
abbreviation
"canonical M n ≡ ∀ i j k. i ≤ n ∧ j ≤ n ∧ k ≤ n ⟶ M i k ≤ M i j + M j k"
lemma fw_canonical:
"cycle_free m n ⟹ canonical (fw m n n n n) n"
proof (clarify, goal_cases)
case 1
with fw_shortest[OF ‹cycle_free m n›] show ?case
by auto
qed
lemma canonical_len:
"canonical M n ⟹ i ≤ n ⟹ j ≤ n ⟹ set xs ⊆ {0..n} ⟹ M i j ≤ len M i j xs"
proof (induction xs arbitrary: i)
case Nil thus ?case by auto
next
case (Cons x xs)
then have "M x j ≤ len M x j xs" by auto
from Cons.prems ‹canonical M n› have "M i j ≤ M i x + M x j" by simp
also with Cons have "… ≤ M i x + len M x j xs" by (simp add: add_mono)
finally show ?case by simp
qed
section ‹Cycle Rotation›
lemma cycle_rotate:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "length xs > 1" "(i, j) ∈ arcs' xs"
shows "∃ ys zs. len M a a xs = len M i i (j # ys @ a # zs) ∧ xs = zs @ i # j # ys" using assms
proof -
assume A: "length xs > 1" "(i, j) ∈ arcs' xs"
from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
from len_decomp[OF this, of M a a]
have "len M a a xs = len M a i zs + len M i a (j # ys)" .
also have "… = len M i a (j # ys) + len M a i zs" by (simp add: comm)
also from len_comp[of M i i "j # ys" a zs] have "… = len M i i (j # ys @ a # zs)" by auto
finally show ?thesis using xs by auto
qed
lemma cycle_rotate_2:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "xs ≠ []" "(i, j) ∈ set (arcs a a xs)"
shows "∃ ys. len M a a xs = len M i i (j # ys) ∧ set ys ⊆ set (a # xs) ∧ length ys < length xs"
using assms proof -
assume A:"xs ≠ []" "(i, j) ∈ set (arcs a a xs)"
{ fix ys assume A:"a = i" "xs = j # ys"
then have ?thesis by auto
} note * = this
{ fix b ys assume A:"a = j" "xs = ys @ [i]"
then have ?thesis
proof (auto, goal_cases)
case 1
have "len M j j (ys @ [i]) = M i j + len M j i ys"
using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
thus ?case by blast
qed
} note ** = this
{ assume "length xs = 1"
then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv)
with A(2) have "a = i ∧ b = j ∨ a = j ∧ b = i" by auto
then have ?thesis using * ** xs by auto
} note *** = this
show ?thesis
proof (cases "length xs = 0")
case True with A show ?thesis by auto
next
case False
thus ?thesis
proof (cases "length xs = 1", goal_cases)
case True with *** show ?thesis by auto
next
case 2
hence "length xs > 1" by linarith
then obtain b c ys where ys:"xs = b # ys @ [c]"
by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust)
thus ?thesis
proof (cases "(i,j) = (a,b)", goal_cases)
case True
with ys * show ?thesis by auto
next
case False
then show ?thesis
proof (cases "(i,j) = (c,a)", goal_cases)
case True
with ys ** show ?thesis by auto
next
case 2
with A(2) ys have "(i, j) ∈ arcs' xs"
using cycle_rotate_2_aux by (auto simp: arcs'_def)
from cycle_rotate[OF ‹length xs > 1› this, of M a] show ?thesis by auto
qed
qed
qed
qed
qed
lemma cycle_rotate_len_arcs:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "length xs > 1" "(i, j) ∈ arcs' xs"
shows "∃ ys zs. len M a a xs = len M i i (j # ys @ a # zs)
∧ set (arcs a a xs) = set (arcs i i (j # ys @ a # zs)) ∧ xs = zs @ i # j # ys"
using assms
proof -
assume A: "length xs > 1" "(i, j) ∈ arcs' xs"
from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
from len_decomp[OF this, of M a a]
have "len M a a xs = len M a i zs + len M i a (j # ys)" .
also have "… = len M i a (j # ys) + len M a i zs" by (simp add: comm)
also from len_comp[of M i i "j # ys" a zs] have "… = len M i i (j # ys @ a # zs)" by auto
finally show ?thesis
using xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed
lemma cycle_rotate_2':
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "xs ≠ []" "(i, j) ∈ set (arcs a a xs)"
shows "∃ ys. len M a a xs = len M i i (j # ys) ∧ set (i # j # ys) = set (a # xs)
∧ 1 + length ys = length xs ∧ set (arcs a a xs) = set (arcs i i (j # ys))"
proof -
note A = assms
{ fix ys assume A:"a = i" "xs = j # ys"
then have ?thesis by auto
} note * = this
{ fix b ys assume A:"a = j" "xs = ys @ [i]"
then have ?thesis
proof (auto, goal_cases)
case 1
have "len M j j (ys @ [i]) = M i j + len M j i ys"
using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
ultimately show ?case by auto
qed
} note ** = this
{ assume "length xs = 1"
then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv)
with A(2) have "a = i ∧ b = j ∨ a = j ∧ b = i" by auto
then have ?thesis using * ** xs by auto
} note *** = this
show ?thesis
proof (cases "length xs = 0")
case True with A show ?thesis by auto
next
case False
thus ?thesis
proof (cases "length xs = 1", goal_cases)
case True with *** show ?thesis by auto
next
case 2
hence "length xs > 1" by linarith
then obtain b c ys where ys:"xs = b # ys @ [c]"
by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust)
thus ?thesis
proof (cases "(i,j) = (a,b)")
case True
with ys * show ?thesis by blast
next
case False
then show ?thesis
proof (cases "(i,j) = (c,a)", goal_cases)
case True
with ys ** show ?thesis by force
next
case 2
with A(2) ys have "(i, j) ∈ arcs' xs"
using cycle_rotate_2_aux by (auto simp add: arcs'_def)
from cycle_rotate_len_arcs[OF ‹length xs > 1› this, of M a] show ?thesis by auto
qed
qed
qed
qed
qed
section ‹Equivalent Characterizations of Cycle-Freeness›
lemma negative_cycle_dest_diag:
"¬ cycle_free M n ⟹ ∃ i xs. i ≤ n ∧ set xs ⊆ {0..n} ∧ len M i i xs < 𝟭"
proof (auto simp: cycle_free_def, goal_cases)
case (1 i xs j)
from this(4) have "len M i j xs < len M i j (rem_cycles i j xs)" by auto
from negative_cycle_dest[OF this] obtain i' ys
where *:"len M i' i' ys < 𝟭" "set (i' # ys) ⊆ set (i # j # xs)" by auto
from this(2) 1(1-3) have "set ys ⊆ {0..n}" "i' ≤ n" by auto
with * show ?case by auto
next
case 2 then show ?case by fastforce
qed
abbreviation cyc_free :: "('a::linordered_ab_monoid_add) mat ⇒ nat ⇒ bool" where
"cyc_free m n ≡ ∀ i xs. i ≤ n ∧ set xs ⊆ {0..n} ⟶ len m i i xs ≥ 𝟭"
lemma cycle_free_diag_intro:
"cyc_free M n ⟹ cycle_free M n"
using negative_cycle_dest_diag by force
lemma cycle_free_diag_equiv:
"cyc_free M n ⟷ cycle_free M n" using negative_cycle_dest_diag
by (force simp: cycle_free_def)
lemma cycle_free_diag_dest:
"cycle_free M n ⟹ cyc_free M n"
using cycle_free_diag_equiv by blast
lemma cyc_free_diag_dest:
assumes "cyc_free M n" "i ≤ n" "set xs ⊆ {0..n}"
shows "len M i i xs ≥ 𝟭"
using assms by auto
lemma cycle_free_0_0:
fixes M :: "('a::linordered_ab_monoid_add) mat"
assumes "cycle_free M n"
shows "M 0 0 ≥ 𝟭"
using cyc_free_diag_dest[OF cycle_free_diag_dest[OF assms], of 0 "[]"] by auto
section ‹More Theorems Related to Floyd-Warshall›
lemma D_cycle_free_len_dest:
"cycle_free m n
⟹ ∀ i ≤ n. ∀ j ≤ n. D m i j n = m' i j ⟹ i ≤ n ⟹ j ≤ n ⟹ set xs ⊆ {0..n}
⟹ ∃ ys. set ys ⊆ {0..n} ∧ len m' i j xs = len m i j ys"
proof (induction xs arbitrary: i)
case Nil
with Nil have "m' i j = D m i j n" by simp
from D_dest''[OF this]
obtain ys where "set ys ⊆ {0..n}" "len m' i j [] = len m i j ys"
by auto
then show ?case by auto
next
case (Cons y ys)
from Cons.IH[OF Cons.prems(1,2) _ ‹j ≤ n›, of y] Cons.prems(5)
obtain zs where zs:"set zs ⊆ {0..n}" "len m' y j ys = len m y j zs" by auto
with Cons have "m' i y = D m i y n" by simp
from D_dest''[OF this] obtain ws where ws:"set ws ⊆ {0..n}" "m' i y = len m i y ws" by auto
with len_comp[of m i j ws y zs] zs Cons.prems(5)
have "len m' i j (y # ys) = len m i j (ws @ y # zs)" "set (ws @ y # zs) ⊆ {0..n}" by auto
then show ?case by blast
qed
lemma D_cyc_free_preservation:
"cyc_free m n ⟹ ∀ i ≤ n. ∀ j ≤ n. D m i j n = m' i j ⟹ cyc_free m' n"
proof (auto, goal_cases)
case (1 i xs)
from D_cycle_free_len_dest[OF _ 1(2,3,3,4)] 1(1) cycle_free_diag_equiv
obtain ys where "set ys ⊆ {0..n} ∧ len m' i i xs = len m i i ys" by fast
with 1(1,3) show ?case by auto
qed
abbreviation "FW m n ≡ fw m n n n n"
lemma FW_cyc_free_preservation:
"cyc_free m n ⟹ cyc_free (FW m n) n"
apply (rule D_cyc_free_preservation)
apply assumption
apply safe
apply (rule fw_shortest_path)
using cycle_free_diag_equiv by auto
lemma cyc_free_diag_dest':
"cyc_free m n ⟹ i ≤ n ⟹ m i i ≥ 𝟭"
proof goal_cases
case 1
then have "i ≤ n ∧ set [] ⊆ {0..n}" by auto
with 1(1) have "𝟭 ≤ len m i i []" by blast
then show ?case by auto
qed
lemma FW_diag_neutral_preservation:
"∀ i ≤ n. M i i = 𝟭 ⟹ cyc_free M n ⟹ ∀ i≤n. (FW M n) i i = 𝟭"
proof (auto, goal_cases)
case (1 i)
from this(3) have "(FW M n) i i ≤ M i i" by (auto intro: fw_mono)
with 1 have "(FW M n) i i ≤ 𝟭" by auto
with cyc_free_diag_dest'[OF FW_cyc_free_preservation[OF 1(2)] ‹i ≤ n›] show "FW M n i i = 𝟭" by auto
qed
lemma FW_fixed_preservation:
fixes M :: "('a::linordered_ab_monoid_add) mat"
assumes A: "i ≤ n" "M 0 i + M i 0 = 𝟭" "canonical (FW M n) n" "cyc_free (FW M n) n"
shows "FW M n 0 i + FW M n i 0 = 𝟭" using assms
proof -
let ?M' = "FW M n"
assume A: "i ≤ n" "M 0 i + M i 0 = 𝟭" "canonical ?M' n" "cyc_free ?M' n"
from ‹i ≤ n› have "?M' 0 i + ?M' i 0 ≤ M 0 i + M i 0" by (auto intro: fw_mono add_mono)
with A(2) have "?M' 0 i + ?M' i 0 ≤ 𝟭" by auto
moreover from ‹canonical ?M' n› ‹i ≤ n›
have "?M' 0 0 ≤ ?M' 0 i + ?M' i 0" by auto
moreover from cyc_free_diag_dest'[OF ‹cyc_free ?M' n›] have "𝟭 ≤ ?M' 0 0" by simp
ultimately show "?M' 0 i + ?M' i 0 = 𝟭" by (auto simp: add_mono)
qed
lemma diag_cyc_free_neutral:
"cyc_free M n ⟹ ∀k≤n. M k k ≤ 𝟭 ⟹ ∀i≤n. M i i = 𝟭"
proof (clarify, goal_cases)
case (1 i)
note A = this
then have "i ≤ n ∧ set [] ⊆ {0..n}" by auto
with A(1) have "𝟭 ≤ M i i" by fastforce
with A(2) ‹i ≤ n› show "M i i = 𝟭" by auto
qed
lemma fw_upd_canonical_id:
"canonical M n ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n ⟹ fw_upd M k i j = M"
proof (auto simp: fw_upd_def upd_def less_eq[symmetric] min.coboundedI2, goal_cases)
case 1
then have "M i j ≤ M i k + M k j" by auto
then have "min (M i j) (M i k + M k j) = M i j" by (simp split: split_min)
thus ?case by force
qed
lemma fw_canonical_id:
"canonical M n ⟹ i ≤ n ⟹ j ≤ n ⟹ k ≤ n ⟹ fw M n k i j = M"
proof (induction k arbitrary: i j)
case 0
then show ?case
proof (induction i arbitrary: j)
case 0
then show ?case
proof (induction j)
case 0 thus ?case by (auto intro: fw_upd_canonical_id)
next
case Suc thus ?case by (auto intro: fw_upd_canonical_id)
qed
next
case Suc
then show ?case
proof (induction j)
case 0 thus ?case by (auto intro: fw_upd_canonical_id)
next
case Suc thus ?case by (auto intro: fw_upd_canonical_id)
qed
qed
next
case Suc
then show ?case
proof (induction i arbitrary: j)
case 0
then show ?case
proof (induction j)
case 0 thus ?case by (auto intro: fw_upd_canonical_id)
next
case Suc thus ?case by (auto intro: fw_upd_canonical_id)
qed
next
case Suc
then show ?case
proof (induction j)
case 0 thus ?case by (auto intro: fw_upd_canonical_id)
next
case Suc thus ?case by (auto intro: fw_upd_canonical_id)
qed
qed
qed
lemmas FW_canonical_id = fw_canonical_id[OF _ order.refl order.refl order.refl]
section ‹Helper Lemmas for Bouyer's Theorem on Approximation›
lemma aux1: "i ≤ n ⟹ j ≤ n ⟹ set xs ⊆ {0..n} ⟹ (a,b) ∈ set (arcs i j xs) ⟹ a ≤ n ∧ b ≤ n"
by (induction xs arbitrary: i) auto
lemma arcs_distinct1:
"i ∉ set xs ⟹ j ∉ set xs ⟹ distinct xs ⟹ xs ≠ [] ⟹ (a,b) ∈ set (arcs i j xs) ⟹ a ≠ b"
apply (induction xs arbitrary: i)
apply fastforce
apply (rename_tac a' xs i)
apply (case_tac xs)
apply auto
done
lemma arcs_distinct2:
"i ∉ set xs ⟹ j ∉ set xs ⟹ distinct xs ⟹ i ≠ j ⟹ (a,b) ∈ set (arcs i j xs) ⟹ a ≠ b"
by (induction xs arbitrary: i) auto
lemma arcs_distinct3: "distinct (a # b # c # xs) ⟹ (i,j) ∈ set (arcs a b xs) ⟹ i ≠ c ∧ j ≠ c"
by (induction xs arbitrary: a) force+
lemma arcs_elem:
assumes "(a, b) ∈ set (arcs i j xs)" shows "a ∈ set (i # xs)" "b ∈ set (j # xs)"
using assms by (induction xs arbitrary: i) auto
lemma arcs_distinct_dest1:
"distinct (i # a # zs) ⟹ (b,c) ∈ set (arcs a j zs) ⟹ b ≠ i"
using arcs_elem by fastforce
lemma arcs_distinct_fix:
"distinct (a # x # xs @ [b]) ⟹ (a,c) ∈ set (arcs a b (x # xs)) ⟹ c = x"
using arcs_elem(1) by fastforce
lemma disjE3: "A ∨ B ∨ C ⟹ (A ⟹ G) ⟹ (B ⟹ G) ⟹ (C ⟹ G) ⟹ G"
by auto
lemma arcs_predecessor:
assumes "(a, b) ∈ set (arcs i j xs)" "a ≠ i"
shows "∃ c. (c, a) ∈ set (arcs i j xs)" using assms
by (induction xs arbitrary: i) auto
lemma arcs_successor:
assumes "(a, b) ∈ set (arcs i j xs)" "b ≠ j"
shows "∃ c. (b,c) ∈ set (arcs i j xs)" using assms
apply (induction xs arbitrary: i)
apply simp
apply (rename_tac aa xs i)
apply (case_tac xs)
by auto
lemma arcs_predecessor':
assumes "(a, b) ∈ set (arcs i j (x # xs))" "(a,b) ≠ (i, x)"
shows "∃ c. (c, a) ∈ set (arcs i j (x # xs))" using assms
by (induction xs arbitrary: i x) auto
lemma arcs_cases:
assumes "(a, b) ∈ set (arcs i j xs)" "xs ≠ []"
shows "(∃ ys. xs = b # ys ∧ a = i) ∨ (∃ ys. xs = ys @ [a] ∧ b = j)
∨ (∃ c d ys. (a,b) ∈ set (arcs c d ys) ∧ xs = c # ys @ [d])"
using assms
proof (induction xs arbitrary: i)
case Nil then show ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "(a, b) = (i, x)")
case True
with Cons.prems show ?thesis by auto
next
case False
note F = this
show ?thesis
proof (cases "xs = []")
case True
with F Cons.prems show ?thesis by auto
next
case False
from F Cons.prems have "(a, b) ∈ set (arcs x j xs)" by auto
from Cons.IH[OF this False] have
"(∃ys. xs = b # ys ∧ a = x) ∨ (∃ys. xs = ys @ [a] ∧ b = j)
∨ (∃c d ys. (a, b) ∈ set (arcs c d ys) ∧ xs = c # ys @ [d])"
.
then show ?thesis
proof (rule disjE3, goal_cases)
case 1
from 1 obtain ys where *: "xs = b # ys ∧ a = x" by auto
show ?thesis
proof (cases "ys = []")
case True
with * show ?thesis by auto
next
case False
then obtain z zs where zs: "ys = zs @ [z]" by (metis append_butlast_last_id)
with * show ?thesis by auto
qed
next
case 2 then show ?case by auto
next
case 3 with False show ?case by auto
qed
qed
qed
qed
lemma arcs_cases':
assumes "(a, b) ∈ set (arcs i j xs)" "xs ≠ []"
shows "(∃ ys. xs = b # ys ∧ a = i) ∨ (∃ ys. xs = ys @ [a] ∧ b = j) ∨ (∃ ys zs. xs = ys @ a # b # zs)"
using assms
proof (induction xs arbitrary: i)
case Nil then show ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "(a, b) = (i, x)")
case True
with Cons.prems show ?thesis by auto
next
case False
note F = this
show ?thesis
proof (cases "xs = []")
case True
with F Cons.prems show ?thesis by auto
next
case False
from F Cons.prems have "(a, b) ∈ set (arcs x j xs)" by auto
from Cons.IH[OF this False] have
"(∃ys. xs = b # ys ∧ a = x) ∨ (∃ys. xs = ys @ [a] ∧ b = j)
∨ (∃ys zs. xs = ys @ a # b # zs)"
.
then show ?thesis
proof (rule disjE3, goal_cases)
case 1
from 1 obtain ys where *: "xs = b # ys ∧ a = x" by auto
show ?thesis
proof (cases "ys = []")
case True
with * show ?thesis by auto
next
case False
then obtain z zs where zs: "ys = zs @ [z]" by (metis append_butlast_last_id)
with * show ?thesis by auto
qed
next
case 2 then show ?case by auto
next
case 3
then obtain ys zs where "xs = ys @ a # b # zs" by auto
then have "x # xs = (x # ys) @ a # b # zs" by auto
then show ?thesis by blast
qed
qed
qed
qed
lemma arcs_successor':
assumes "(a, b) ∈ set (arcs i j xs)" "b ≠ j"
shows "∃ c. xs = [b] ∧ a = i ∨ (∃ ys. xs = b # c # ys ∧ a = i) ∨ (∃ ys. xs = ys @ [a,b] ∧ c = j)
∨ (∃ ys zs. xs = ys @ a # b # c # zs)"
using assms
proof (induction xs arbitrary: i)
case Nil then show ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "(a, b) = (i, x)")
case True
with Cons.prems show ?thesis by (cases xs) auto
next
case False
note F = this
show ?thesis
proof (cases "xs = []")
case True
with F Cons.prems show ?thesis by auto
next
case False
from F Cons.prems have "(a, b) ∈ set (arcs x j xs)" by auto
from Cons.IH[OF this ‹b ≠ j›] obtain c where c:
"xs = [b] ∧ a = x ∨ (∃ys. xs = b # c # ys ∧ a = x) ∨ (∃ys. xs = ys @ [a, b] ∧ c = j)
∨ (∃ys zs. xs = ys @ a # b # c # zs)"
..
then show ?thesis
proof (standard, goal_cases)
case 1 with Cons.prems show ?case by auto
next
case 2
then show ?thesis
proof (rule disjE3, goal_cases)
case 1
from 1 obtain ys where *: "xs = b # ys ∧ a = x" by auto
show ?thesis
proof (cases "ys = []")
case True
with * show ?thesis by auto
next
case False
then obtain z zs where zs: "ys = z # zs" by (cases ys) auto
with * show ?thesis by fastforce
qed
next
case 2 then show ?case by auto
next
case 3
then obtain ys zs where "xs = ys @ a # b # c # zs" by auto
then have "x # xs = (x # ys) @ a # b # c # zs" by auto
then show ?thesis by blast
qed
qed
qed
qed
qed
lemma list_last:
"xs = [] ∨ (∃ y ys. xs = ys @ [y])"
by (induction xs) auto
lemma arcs_predecessor'':
assumes "(a, b) ∈ set (arcs i j xs)" "a ≠ i"
shows "∃ c. xs = [a] ∨ (∃ ys. xs = a # b # ys) ∨ (∃ ys. xs = ys @ [c,a] ∧ b = j)
∨ (∃ ys zs. xs = ys @ c # a # b # zs)"
using assms
proof (induction xs arbitrary: i)
case Nil then show ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "(a, b) = (i, x)")
case True
with Cons.prems show ?thesis by (cases xs) auto
next
case False
note F = this
show ?thesis
proof (cases "xs = []")
case True
with F Cons.prems show ?thesis by auto
next
case False
from F Cons.prems have *: "(a, b) ∈ set (arcs x j xs)" by auto
from False obtain y ys where xs: "xs = y # ys" by (cases xs) auto
show ?thesis
proof (cases "(a,b) = (x,y)")
case True with * xs show ?thesis by auto
next
case False
with * xs have **: "(a, b) ∈ set (arcs y j ys)" by auto
show ?thesis
proof (cases "ys = []")
case True with ** xs show ?thesis by force
next
case False
from arcs_cases'[OF ** this] obtain ws zs where ***:
"ys = b # ws ∧ a = y ∨ ys = ws @ [a] ∧ b = j ∨ ys = ws @ a # b # zs"
by auto
then show ?thesis
apply rule
using xs apply blast
apply safe
using xs list_last[of ws] apply -
apply (rotate_tac 3)
apply (case_tac "ws = []")
apply auto[]
apply (subgoal_tac "∃y ys. ws = ys @ [y]")
apply fastforce
apply simp
apply (case_tac "ws = []")
apply (subgoal_tac "x # xs = [x] @ y # a # b # zs")
apply (rule exI[where x = y])
apply blast
apply simp
subgoal
proof goal_cases
case 1
then obtain u us where "ws = us @ [u]" by auto
with 1(1,2) have "x # xs = (x # y # us) @ u # a # b # zs" by auto
then show ?case by blast
qed
done
qed
qed
qed
qed
qed
lemma arcs_ex_middle:
"∃ b. (a, b) ∈ set (arcs i j (ys @ a # xs))"
by (induction xs arbitrary: i ys) (auto simp: arcs_decomp)
lemma arcs_ex_head:
"∃ b. (i, b) ∈ set (arcs i j xs)"
by (cases xs) auto
subsection ‹Successive›
fun successive where
"successive _ [] = True" |
"successive P [_] = True" |
"successive P (x # y # xs) ⟷ ¬ P y ∧ successive P xs ∨ ¬ P x ∧ successive P (y # xs)"
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, 0, 0, Suc 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [Suc 0, 0, Suc 0, 0, Suc 0]" by simp
lemma "¬ successive (λ x. x > (0 :: nat)) [Suc 0, Suc 0, 0, Suc 0]" by simp
lemma "successive (λ x. x > (0 :: nat)) [0, 0, Suc 0, 0]" by simp
lemma successive_step: "successive P (x # xs) ⟹ ¬ P x ⟹ successive P xs"
apply (cases xs)
apply simp
apply (rename_tac y ys)
apply (case_tac ys)
apply auto
done
lemma successive_step_2: "successive P (x # y # xs) ⟹ ¬ P y ⟹ successive P xs"
apply (cases xs)
apply simp
apply (rename_tac z zs)
apply (case_tac zs)
apply auto
done
lemma successive_stepI:
"successive P xs ⟹ ¬ P x ⟹ successive P (x # xs)"
by (cases xs) auto
theorem list_two_induct[case_names Nil Single Cons]:
fixes P :: "'a list ⇒ bool"
and list :: "'a list"
assumes Nil: "P []"
assumes Single: "⋀ x. P [x]"
and Cons: "⋀x1 x2 xs. P xs ⟹ P (x2 # xs) ⟹ P (x1 # x2 # xs)"
shows "P xs"
using assms
apply (induction "length xs" arbitrary: xs rule: less_induct)
apply (rename_tac xs)
apply (case_tac xs)
apply simp
apply (rename_tac ys)
apply (case_tac ys)
apply simp
apply (rename_tac zs)
apply (case_tac zs)
by auto
lemma successive_end_1:
"successive P xs ⟹ ¬ P x ⟹ successive P (xs @ [x])"
by (induction _ xs rule: list_two_induct) auto
lemma successive_ends_1:
"successive P xs ⟹ ¬ P x ⟹ successive P ys ⟹ successive P (xs @ x # ys)"
by (induction _ xs rule: list_two_induct) (fastforce intro: successive_stepI)+
lemma successive_ends_1':
"successive P xs ⟹ ¬ P x ⟹ P y ⟹ ¬ P z ⟹ successive P ys ⟹ successive P (xs @ x # y # z # ys)"
by (induction _ xs rule: list_two_induct) (fastforce intro: successive_stepI)+
lemma successive_end_2:
"successive P xs ⟹ ¬ P x ⟹ successive P (xs @ [x,y])"
by (induction _ xs rule: list_two_induct) auto
lemma successive_end_2':
"successive P (xs @ [x]) ⟹ ¬ P x ⟹ successive P (xs @ [x,y])"
by (induction _ xs rule: list_two_induct) auto
lemma successive_end_3:
"successive P (xs @ [x]) ⟹ ¬ P x ⟹ P y ⟹ ¬ P z ⟹ successive P (xs @ [x,y,z])"
by (induction _ xs rule: list_two_induct) auto
lemma successive_step_rev:
"successive P (xs @ [x]) ⟹ ¬ P x ⟹ successive P xs"
by (induction _ xs rule: list_two_induct) auto
lemma successive_glue:
"successive P (zs @ [z]) ⟹ successive P (x # xs) ⟹ ¬ P z ∨ ¬ P x ⟹ successive P (zs @ [z] @ x # xs)"
proof goal_cases
case A: 1
show ?thesis
proof (cases "P x")
case False
with A(1,2) successive_ends_1 successive_step show ?thesis by fastforce
next
case True
with A(1,3) successive_step_rev have "¬ P z" "successive P zs" by fastforce+
with A(2) successive_ends_1 show ?thesis by fastforce
qed
qed
lemma successive_glue':
"successive P (zs @ [y]) ∧ ¬ P z ∨ successive P zs ∧ ¬ P y
⟹ successive P (x # xs) ∧ ¬ P w ∨ successive P xs ∧ ¬ P x
⟹ ¬ P z ∨ ¬ P w ⟹ successive P (zs @ y # z # w # x # xs)"
by (metis append_Cons append_Nil successive.simps(3) successive_ends_1 successive_glue successive_stepI)
lemma successive_dest_head:
"xs = w # x # ys ⟹ successive P xs ⟹ successive P (x # xs) ∧ ¬ P w ∨ successive P xs ∧ ¬ P x"
by auto
lemma successive_dest_tail:
"xs = zs @ [y,z] ⟹ successive P xs ⟹ successive P (zs @ [y]) ∧ ¬ P z ∨ successive P zs ∧ ¬ P y"
apply (induction _ xs arbitrary: zs rule: list_two_induct)
apply simp+
apply (rename_tac zs)
apply (case_tac zs)
apply simp
apply (rename_tac ws)
apply (case_tac ws)
apply force+
done
lemma successive_split:
"xs = ys @ zs ⟹ successive P xs ⟹ successive P ys ∧ successive P zs"
apply (induction _ xs arbitrary: ys rule: list_two_induct)
apply simp
apply (rename_tac ys, case_tac ys)
apply simp
apply simp
apply (rename_tac ys, case_tac ys)
apply simp
apply (rename_tac list, case_tac list)
apply (auto intro: successive_stepI)
done
lemma successive_decomp:
"xs = x # ys @ zs @ [z] ⟹ successive P xs ⟹ ¬ P x ∨ ¬ P z ⟹ successive P (zs @ [z] @ (x # ys))"
by (metis Cons_eq_appendI successive_glue successive_split)
lemma successive_predecessor:
assumes "(a, b) ∈ set (arcs i j xs)" "a ≠ i" "successive P (arcs i j xs)" "P (a,b)" "xs ≠ []"
shows "∃ c. (xs = [a] ∧ c = i ∨ (∃ ys. xs = a # b # ys ∧ c = i) ∨ (∃ ys. xs = ys @ [c,a] ∧ b = j)
∨ (∃ ys zs. xs = ys @ c # a # b # zs)) ∧ ¬ P (c,a)"
proof -
from arcs_predecessor''[OF assms(1,2)] obtain c where c:
"xs = [a] ∨ (∃ys. xs = a # b # ys) ∨ (∃ys. xs = ys @ [c, a] ∧ b = j)
∨ (∃ys zs. xs = ys @ c # a # b # zs)"
by auto
then show ?thesis
proof (safe, goal_cases)
case 1
with assms have "arcs i j xs = [(i, a), (a, j)]" by auto
with assms have "¬ P (i, a)" by auto
with 1 show ?case by simp
next
case 2
with assms have "¬ P (i, a)" by fastforce
with 2 show ?case by auto
next
case 3
with assms have "¬ P (c, a)" using arcs_decomp successive_dest_tail by fastforce
with 3 show ?case by auto
next
case 4
with assms(3,4) have "¬ P (c, a)" using arcs_decomp successive_split by fastforce
with 4 show ?case by auto
qed
qed
thm arcs_successor'
lemma successive_successor:
assumes "(a, b) ∈ set (arcs i j xs)" "b ≠ j" "successive P (arcs i j xs)" "P (a,b)" "xs ≠ []"
shows "∃ c. (xs = [b] ∧ c = j ∨ (∃ ys. xs = b # c # ys) ∨ (∃ ys. xs = ys @ [a,b] ∧ c = j)
∨ (∃ ys zs. xs = ys @ a # b # c # zs)) ∧ ¬ P (b,c)"
proof -
from arcs_successor'[OF assms(1,2)] obtain c where c:
"xs = [b] ∧ a = i ∨ (∃ys. xs = b # c # ys ∧ a = i) ∨ (∃ys. xs = ys @ [a, b] ∧ c = j)
∨ (∃ys zs. xs = ys @ a # b # c # zs)"
..
then show ?thesis
proof (safe, goal_cases)
case 1
with assms(1,2) have "arcs i j xs = [(a,b), (b,j)]" by auto
with assms have "¬ P (b,j)" by auto
with 1 show ?case by simp
next
case 2
with assms have "¬ P (b, c)" by fastforce
with 2 show ?case by auto
next
case 3
with assms have "¬ P (b, c)" using arcs_decomp successive_dest_tail by fastforce
with 3 show ?case by auto
next
case 4
with assms(3,4) have "¬ P (b, c)" using arcs_decomp successive_split by fastforce
with 4 show ?case by auto
qed
qed
lemmas add_mono_right = add_mono[OF order_refl]
lemmas add_mono_left = add_mono[OF _ order_refl]
subsubsection ‹Obtaining successive and distinct paths›
lemma canonical_successive:
fixes A B
defines "M ≡ λ i j. min (A i j) (B i j)"
assumes "canonical A n"
assumes "set xs ⊆ {0..n}"
assumes "i ≤ n" "j ≤ n"
shows "∃ ys. len M i j ys ≤ len M i j xs ∧ set ys ⊆ {0..n}
∧ successive (λ (a, b). M a b = A a b) (arcs i j ys)"
using assms
proof (induction xs arbitrary: i rule: list_two_induct)
case Nil show ?case by fastforce
next
case 2: (Single x i)
show ?case
proof (cases "M i x = A i x ∧ M x j = A x j")
case False
then have "successive (λ(a, b). M a b = A a b) (arcs i j [x])" by auto
with 2 show ?thesis by blast
next
case True
with 2 have "M i j ≤ M i x + M x j" unfolding min_def by fastforce
with 2(3-) show ?thesis apply simp apply (rule exI[where x = "[]"]) by auto
qed
next
case 3: (Cons x y xs i)
show ?case
proof (cases "M i y ≤ M i x + M x y", goal_cases)
case 1
from 3 obtain ys where
"len M i j ys ≤ len M i j (y # xs) ∧ set ys ⊆ {0..n}
∧ successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j ys)"
by fastforce
moreover from 1 have "len M i j (y # xs) ≤ len M i j (x # y # xs)"
using add_mono by (auto simp: assoc[symmetric])
ultimately show ?case by force
next
case False
{ assume "M i x = A i x" "M x y = A x y"
with 3(3-) have "A i y ≤ M i x + M x y" by auto
then have "M i y ≤ M i x + M x y" unfolding M_def min_def by auto
} note * = this
with False have "M i x ≠ A i x ∨ M x y ≠ A x y" by auto
then show ?thesis
proof (standard, goal_cases)
case 1
from 3 obtain ys where ys:
"len M x j ys ≤ len M x j (y # xs)" "set ys ⊆ {0..n}"
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs x j ys)"
by force+
from 1 successive_stepI[OF ys(3), of "(i, x)"] have
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j (x # ys))"
by auto
moreover have "len M i j (x # ys) ≤ len M i j (x # y # xs)" using add_mono_right[OF ys(1)]
by auto
ultimately show ?case using 3(5) ys(2) by fastforce
next
case 2
from 3 obtain ys where ys:
"len M y j ys ≤ len M y j xs" "set ys ⊆ {0..n}"
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs y j ys)"
by force+
from this(3) 2 have
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j (x # y # ys))"
by simp
moreover from add_mono_right[OF ys(1)] have
"len M i j (x # y # ys) ≤ len M i j (x # y # xs)"
by (auto simp: assoc[symmetric])
ultimately show ?thesis using ys(2) 3(5) by fastforce
qed
qed
qed
lemma canonical_successive_distinct:
fixes A B
defines "M ≡ λ i j. min (A i j) (B i j)"
assumes "canonical A n"
assumes "set xs ⊆ {0..n}"
assumes "i ≤ n" "j ≤ n"
assumes "distinct xs" "i ∉ set xs" "j ∉ set xs"
shows "∃ ys. len M i j ys ≤ len M i j xs ∧ set ys ⊆ set xs
∧ successive (λ (a, b). M a b = A a b) (arcs i j ys)
∧ distinct ys ∧ i ∉ set ys ∧ j ∉ set ys"
using assms
proof (induction xs arbitrary: i rule: list_two_induct)
case Nil show ?case by fastforce
next
case 2: (Single x i)
show ?case
proof (cases "M i x = A i x ∧ M x j = A x j")
case False
then have "successive (λ(a, b). M a b = A a b) (arcs i j [x])" by auto
with 2 show ?thesis by blast
next
case True
with 2 have "M i j ≤ M i x + M x j" unfolding min_def by fastforce
with 2(3-) show ?thesis apply simp apply (rule exI[where x = "[]"]) by auto
qed
next
case 3: (Cons x y xs i)
show ?case
proof (cases "M i y ≤ M i x + M x y")
case 1: True
from 3(2)[OF 3(3,4)] 3(5-10) obtain ys where ys:
"len M i j ys ≤ len M i j (y # xs)" "set ys ⊆ set (x # y # xs)"
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j ys)"
"distinct ys ∧ i ∉ set ys ∧ j ∉ set ys"
by fastforce
moreover from 1 have "len M i j (y # xs) ≤ len M i j (x # y # xs)"
using add_mono by (auto simp: assoc[symmetric])
ultimately have "len M i j ys ≤ len M i j (x # y # xs)" by auto
then show ?thesis using ys(2-) by blast
next
case False
{ assume "M i x = A i x" "M x y = A x y"
with 3(3-) have "A i y ≤ M i x + M x y" by auto
then have "M i y ≤ M i x + M x y" unfolding M_def min_def by auto
} note * = this
with False have "M i x ≠ A i x ∨ M x y ≠ A x y" by auto
then show ?thesis
proof (standard, goal_cases)
case 1
from 3(2)[OF 3(3,4)] 3(5-10) obtain ys where ys:
"len M x j ys ≤ len M x j (y # xs)" "set ys ⊆ set (y # xs)"
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs x j ys)"
"distinct ys" "i ∉ set ys" "x ∉ set ys" "j ∉ set ys"
by fastforce
from 1 successive_stepI[OF ys(3), of "(i, x)"] have
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j (x # ys))"
by auto
moreover have "len M i j (x # ys) ≤ len M i j (x # y # xs)" using add_mono_right[OF ys(1)]
by auto
moreover have "distinct (x # ys)" "i ∉ set (x # ys)" "j ∉ set (x # ys)" using ys(4-) 3(8-)
by auto
moreover from ys(2) have "set (x # ys) ⊆ set (x # y # xs)" by auto
ultimately show ?case by fastforce
next
case 2
from 3(1)[OF 3(3,4)] 3(5-) obtain ys where ys:
"len M y j ys ≤ len M y j xs" "set ys ⊆ set xs"
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs y j ys)"
"distinct ys" "j ∉ set ys" "y ∉ set ys" "i ∉ set ys" "x ∉ set ys"
by fastforce
from this(3) 2 have
"successive (λa. case a of (a, b) ⇒ M a b = A a b) (arcs i j (x # y # ys))"
by simp
moreover from add_mono_right[OF ys(1)] have
"len M i j (x # y # ys) ≤ len M i j (x # y # xs)"
by (auto simp: assoc[symmetric])
moreover have "distinct (x # y # ys)" "i ∉ set (x # y # ys)" "j ∉ set (x # y # ys)"
using ys(4-) 3(8-) by auto
ultimately show ?thesis using ys(2) by fastforce
qed
qed
qed
lemma successive_snd_last: "successive P (xs @ [x, y]) ⟹ P y ⟹ ¬ P x"
by (induction _ xs rule: list_two_induct) auto
lemma canonical_shorten_rotate_neg_cycle:
fixes A B
defines "M ≡ λ i j. min (A i j) (B i j)"
assumes "canonical A n"
assumes "set xs ⊆ {0..n}"
assumes "i ≤ n"
assumes "len M i i xs < 𝟭"
shows "∃ j ys. len M j j ys < 𝟭 ∧ set (j # ys) ⊆ set (i # xs)
∧ successive (λ (a, b). M a b = A a b) (arcs j j ys)
∧ distinct ys ∧ j ∉ set ys ∧
(ys ≠ [] ⟶ M j (hd ys) ≠ A j (hd ys) ∨ M (last ys) j ≠ A (last ys) j)"
using assms
proof -
note A = assms
from negative_len_shortest[OF _ A(5)] obtain j ys where ys:
"distinct (j # ys)" "len M j j ys < 𝟭" "j ∈ set (i # xs)" "set ys ⊆ set xs"
by blast
from this(1,3) canonical_successive_distinct[OF A(2) subset_trans[OF this(4) A(3)], of j j B] A(3,4)
obtain zs where zs:
"len M j j zs ≤ len M j j ys"
"set zs ⊆ set ys" "successive (λ(a, b). M a b = A a b) (arcs j j zs)"
"distinct zs" "j ∉ set zs"
by (force simp: M_def)
show ?thesis
proof (cases "zs = []")
assume "zs ≠ []"
then obtain w ws where ws: "zs = w # ws" by (cases zs) auto
show ?thesis
proof (cases "ws = []")
case False
then obtain u us where us: "ws = us @ [u]" by (induction ws) auto
show ?thesis
proof (cases "M j w = A j w ∧ M u j = A u j")
case True
have "u ≤ n" "j ≤ n" "w ≤ n" using us ws zs(2) ys(3,4) A(3,4) by auto
with A(2) True have "M u w ≤ M u j + M j w" unfolding M_def min_def by fastforce
then have
"len M u u (w # us) ≤ len M j j zs"
using ws us by (simp add: len_comp comm) (auto intro: add_mono simp: assoc[symmetric])
moreover have "set (u # w # us) ⊆ set (i # xs)" using ws us zs(2) ys(3,4) by auto
moreover have "distinct (w # us)" "u ∉ set (w # us)" using ws us zs(4) by auto
moreover have "successive (λ(a, b). M a b = A a b) (arcs u u (w # us))"
proof (cases us)
case Nil
with zs(3) ws us True show ?thesis by auto
next
case (Cons v vs)
with zs(3) ws us True have "M w v ≠ A w v" by auto
with ws us Cons zs(3) True arcs_decomp_tail successive_split show ?thesis by (simp, blast)
qed
moreover have "M (last (w # us)) u ≠ A (last (w # us)) u"
proof (cases "us = []")
case T: True
with zs(3) ws us True show ?thesis by auto
next
case False
then obtain v vs where vs: "us = vs @ [v]" by (induction us) auto
with ws us have "arcs j j zs = arcs j v (w # vs) @ [(v, u), (u,j)]" by (simp add: arcs_decomp)
with zs(3) True have "M v u ≠ A v u"
using successive_snd_last[of "λ(a, b). M a b = A a b" "arcs j v (w # vs)"] by auto
with vs show ?thesis by simp
qed
ultimately show ?thesis using zs(1) ys(2)
by (intro exI[where x = u], intro exI[where x = "w # us"]) fastforce
next
case False
with zs ws us ys show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) auto
qed
next
case True
with True ws zs ys show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) fastforce
qed
next
case True
with ys zs show ?thesis by (intro exI[where x = j], intro exI[where x = "zs"]) fastforce
qed
qed
lemma successive_arcs_extend_last:
"successive P (arcs i j xs) ⟹ ¬ P (i, hd xs) ∨ ¬ P (last xs, j) ⟹ xs ≠ []
⟹ successive P (arcs i j xs @ [(i, hd xs)])"
proof -
assume a1: "¬ P (i, hd xs) ∨ ¬ P (last xs, j)"
assume a2: "successive P (arcs i j xs)"
assume a3: "xs ≠ []"
then have f4: "¬ P (last xs, j) ⟶ successive P (arcs i (last xs) (butlast xs))"
using a2 by (metis (no_types) append_butlast_last_id arcs_decomp_tail successive_step_rev)
have f5: "arcs i j xs = arcs i (last xs) (butlast xs) @ [(last xs, j)]"
using a3 by (metis (no_types) append_butlast_last_id arcs_decomp_tail)
have "([] @ arcs i j xs @ [(i, hd xs)]) @ [(i, hd xs)] = arcs i j xs @ [(i, hd xs), (i, hd xs)]"
by simp
then have "P (last xs, j) ⟶ successive P (arcs i j xs @ [(i, hd xs)])"
using a2 a1 by (metis (no_types) self_append_conv2 successive_end_2 successive_step_rev)
then show ?thesis
using f5 f4 successive_end_2 by fastforce
qed
lemma cycle_rotate_arcs:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "length xs > 1" "(i, j) ∈ arcs' xs"
shows "∃ ys zs. set (arcs a a xs) = set (arcs i i (j # ys @ a # zs)) ∧ xs = zs @ i # j # ys" using assms
proof -
assume A: "length xs > 1" "(i, j) ∈ arcs' xs"
from arcs'_decomp[OF this] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
with arcs_decomp[OF this, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
show ?thesis by force
qed
lemma cycle_rotate_len_arcs_successive:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "length xs > 1" "(i, j) ∈ arcs' xs" "successive P (arcs a a xs)" "¬ P (a, hd xs) ∨ ¬ P (last xs, a)"
shows "∃ ys zs. len M a a xs = len M i i (j # ys @ a # zs)
∧ set (arcs a a xs) = set (arcs i i (j # ys @ a # zs)) ∧ xs = zs @ i # j # ys
∧ successive P (arcs i i (j # ys @ a # zs))"
using assms
proof -
note A = assms
from arcs'_decomp[OF A(1,2)] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
note arcs1 = arcs_decomp[OF xs, of a a]
note arcs2 = arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
have *:"successive P (arcs i i (j # ys @ a # zs))"
proof (cases "ys = []")
case True
show ?thesis
proof (cases zs)
case Nil
with A(3,4) xs True show ?thesis by auto
next
case (Cons z zs')
with True arcs2 A(3,4) xs show ?thesis apply simp
by (metis arcs.simps(1,2) arcs1 successive.simps(3) successive_split successive_step)
qed
next
case False
then obtain y ys' where ys: "ys = ys' @ [y]" by (metis append_butlast_last_id)
show ?thesis
proof (cases zs)
case Nil
with A(3,4) xs ys have
"¬ P (a, i) ∨ ¬ P (y, a)" "successive P (arcs a a (i # j # ys' @ [y]))"
by simp+
from successive_decomp[OF _ this(2,1)] show ?thesis using ys Nil arcs_decomp by fastforce
next
case (Cons z zs')
with A(3,4) xs ys have
"¬ P (a, z) ∨ ¬ P (y, a)" "successive P (arcs a a (z # zs' @ i # j # ys' @ [y]))"
by simp+
from successive_decomp[OF _ this(2,1)] show ?thesis using ys Cons arcs_decomp by fastforce
qed
qed
from len_decomp[OF xs, of M a a] have "len M a a xs = len M a i zs + len M i a (j # ys)" .
also have "… = len M i a (j # ys) + len M a i zs" by (simp add: comm)
also from len_comp[of M i i "j # ys" a zs] have "… = len M i i (j # ys @ a # zs)" by auto
finally show ?thesis
using * xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed
lemma successive_successors:
"xs = ys @ a # b # c # zs ⟹ successive P (arcs i j xs) ⟹ ¬ P (a,b) ∨ ¬ P (b, c)"
apply (induction _ xs arbitrary: i ys rule: list_two_induct)
apply fastforce
apply fastforce
apply (rename_tac ys, case_tac ys)
apply fastforce
apply (rename_tac list, case_tac list)
apply fastforce+
done
lemma successive_successors':
"xs = ys @ a # b # zs ⟹ successive P xs ⟹ ¬ P a ∨ ¬ P b"
using successive_split by fastforce
lemma cycle_rotate_len_arcs_successive':
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "length xs > 1" "(i, j) ∈ arcs' xs" "successive P (arcs a a xs)"
"¬ P (a, hd xs) ∨ ¬ P (last xs, a)"
shows "∃ ys zs. len M a a xs = len M i i (j # ys @ a # zs)
∧ set (arcs a a xs) = set (arcs i i (j # ys @ a # zs)) ∧ xs = zs @ i # j # ys
∧ successive P (arcs i i (j # ys @ a # zs) @ [(i,j)])"
using assms
proof -
note A = assms
from arcs'_decomp[OF A(1,2)] obtain ys zs where xs: "xs = zs @ i # j # ys" by blast
note arcs1 = arcs_decomp[OF xs, of a a]
note arcs2 = arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i]
have *:"successive P (arcs i i (j # ys @ a # zs) @ [(i,j)])"
proof (cases "ys = []")
case True
show ?thesis
proof (cases zs)
case Nil
with A(3,4) xs True show ?thesis by auto
next
case (Cons z zs')
with True arcs2 A(3,4) xs show ?thesis
apply simp
apply (cases "P (a, z)")
apply (simp add: arcs_decomp)
apply (simp only: append_Cons[symmetric])
using successive_split[of "((a, z) # arcs z i zs') @ [(i, j), (j, a)]" _ "[(j, a)]" P]
apply auto[]
subgoal
proof simp
assume a1: "successive P ((a, z) # arcs z a (zs' @ [i, j]))"
assume a2: "¬ P (a, z)"
assume a3: "zs = z # zs'"
assume a4: "ys = []"
assume a5: "xs = z # zs' @ [i, j]"
have f6: "∀p pa ps. ¬ successive p ((pa::nat × nat) # ps) ∨ p pa ∨ successive p ps"
by (meson successive_step)
have "(a, z) # arcs z i zs' @ (i, j) # arcs j a [] = arcs a a xs"
using a4 a3 by (simp add: arcs1)
then have "arcs z a (zs' @ [i, j]) = arcs z i zs' @ [(i, j), (j, a)]"
using a5 by simp
then show
"¬ P (j, a) ∧ successive P ((a, z) # arcs z i zs' @ [(i, j)])
∨ ¬ P (i, j) ∧ (successive P (arcs z i zs' @ [(i, j)])
∨ ¬ P (j, a) ∧ successive P ((a, z) # arcs z i zs' @ [(i, j)]))"
using f6 a2 a1
by (metis successive.simps(1) successive_dest_tail successive_ends_1 successive_stepI)
qed
done
qed
next
case False
then obtain y ys' where ys: "ys = ys' @ [y]" by (metis append_butlast_last_id)
show ?thesis
proof (cases zs)
case Nil
with A(3,4) xs ys have *:
"¬ P (a, i) ∨ ¬ P (y, a)" "successive P (arcs a a (i # j # ys' @ [y]))"
by simp+
from successive_decomp[OF _ this(2,1)] ys Nil arcs_decomp have
"successive P (arcs i i (j # ys @ a # zs))"
by fastforce
moreover from * have "¬ P (a, i) ∨ ¬ P (i, j)" by auto
ultimately show ?thesis
by (metis append_Cons last_snoc list.distinct(1) list.sel(1) Nil successive_arcs_extend_last)
next
case (Cons z zs')
with A(3,4) xs ys have *:
"¬ P (a, z) ∨ ¬ P (y, a)" "successive P (arcs a a (z # zs' @ i # j # ys' @ [y]))"
by simp_all
from successive_decomp[OF _ this(2,1)] ys Cons arcs_decomp have **:
"successive P (arcs i i (j # ys @ a # zs))"
by fastforce
from Cons have "zs ≠ []" by auto
then obtain w ws where ws: "zs = ws @ [w]" by (induction zs) auto
with A(3,4) xs ys have *:
"successive P (arcs a a (ws @ [w] @ i # j # ys' @ [y]))"
by simp
from successive_successors[OF _ *] have "¬ P (w, i) ∨ ¬ P (i, j)" by auto
with * show ?thesis
by (metis ** append_is_Nil_conv last.simps last_append list.distinct(2) list.sel(1)
successive_arcs_extend_last ws)
qed
qed
from len_decomp[OF xs, of M a a] have "len M a a xs = len M a i zs + len M i a (j # ys)" .
also have "… = len M i a (j # ys) + len M a i zs" by (simp add: comm)
also from len_comp[of M i i "j # ys" a zs] have "… = len M i i (j # ys @ a # zs)" by auto
finally show ?thesis
using * xs arcs_decomp[OF xs, of a a] arcs_decomp[of "j # ys @ a # zs" "j # ys" a zs i i] by force
qed
lemma cycle_rotate_3:
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "xs ≠ []" "(i, j) ∈ set (arcs a a xs)" "successive P (arcs a a xs)" "¬ P (a, hd xs) ∨ ¬ P (last xs, a)"
shows "∃ ys. len M a a xs = len M i i (j # ys) ∧ set (i # j # ys) = set (a # xs) ∧ 1 + length ys = length xs
∧ set (arcs a a xs) = set (arcs i i (j # ys))
∧ successive P (arcs i i (j # ys))"
proof -
note A = assms
{ fix ys assume A:"a = i" "xs = j # ys"
with assms(3) have ?thesis by auto
} note * = this
have **: ?thesis if A: "a = j" "xs = ys @ [i]" for ys using A
proof (safe, goal_cases)
case 1
have "len M j j (ys @ [i]) = M i j + len M j i ys"
using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
moreover with assms(3,4) A have "successive P ((i,j) # arcs j i ys)"
apply simp
apply (case_tac ys)
apply simp
apply simp
by (metis arcs.simps(2) calculation(2) 1(1) successive_split successive_step)
ultimately show ?case by auto
qed
{ assume "length xs = 1"
then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv)
with A(2) have "a = i ∧ b = j ∨ a = j ∧ b = i" by auto
then have ?thesis using * ** xs by auto
} note *** = this
show ?thesis
proof (cases "length xs = 0")
case True with A show ?thesis by auto
next
case False
thus ?thesis
proof (cases "length xs = 1", goal_cases)
case True with *** show ?thesis by auto
next
case 2
hence "length xs > 1" by linarith
then obtain b c ys where ys:"xs = b # ys @ [c]"
by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust)
thus ?thesis
proof (cases "(i,j) = (a,b)")
case True
with ys * show ?thesis by blast
next
case False
then show ?thesis
proof (cases "(i,j) = (c,a)", goal_cases)
case True
with ys ** show ?thesis by force
next
case 2
with A(2) ys have "(i, j) ∈ arcs' xs"
using cycle_rotate_2_aux by (auto simp add: arcs'_def)
from cycle_rotate_len_arcs_successive[OF ‹length xs > 1› this A(3,4), of M] show ?thesis
by auto
qed
qed
qed
qed
qed
lemma cycle_rotate_3':
fixes M :: "('a :: linordered_ab_monoid_add) mat"
assumes "xs ≠ []" "(i, j) ∈ set (arcs a a xs)" "successive P (arcs a a xs)" "¬ P (a, hd xs) ∨ ¬ P (last xs, a)"
shows "∃ ys. len M a a xs = len M i i (j # ys) ∧ set (i # j # ys) = set (a # xs) ∧ 1 + length ys = length xs
∧ set (arcs a a xs) = set (arcs i i (j # ys))
∧ successive P (arcs i i (j # ys) @ [(i, j)])"
proof -
note A = assms
have *: ?thesis if "a = i" "xs = j # ys" for ys
using that assms(3) successive_arcs_extend_last[OF assms(3,4)] by auto
have **: ?thesis if A:"a = j" "xs = ys @ [i]" for ys
using A proof (auto, goal_cases)
case 1
have "len M j j (ys @ [i]) = M i j + len M j i ys"
using len_decomp[of "ys @ [i]" ys i "[]" M j j] by (auto simp: comm)
moreover have "arcs j j (ys @ [i]) = arcs j i ys @ [(i, j)]" using arcs_decomp_tail by auto
moreover with assms(3,4) A have "successive P ((i,j) # arcs j i ys @ [(i, j)])"
apply simp
apply (case_tac ys)
apply simp
apply simp
by (metis successive_step)
ultimately show ?case by auto
qed
{ assume "length xs = 1"
then obtain b where xs: "xs = [b]" by (metis One_nat_def length_0_conv length_Suc_conv)
with A(2) have "a = i ∧ b = j ∨ a = j ∧ b = i" by auto
then have ?thesis using * ** xs by auto
} note *** = this
show ?thesis
proof (cases "length xs = 0")
case True with A show ?thesis by auto
next
case False
thus ?thesis
proof (cases "length xs = 1", goal_cases)
case True with *** show ?thesis by auto
next
case 2
hence "length xs > 1" by linarith
then obtain b c ys where ys:"xs = b # ys @ [c]"
by (metis One_nat_def assms(1) 2(2) length_0_conv length_Cons list.exhaust rev_exhaust)
thus ?thesis
proof (cases "(i,j) = (a,b)")
case True
with ys * show ?thesis by blast
next
case False
then show ?thesis
proof (cases "(i,j) = (c,a)", goal_cases)
case True
with ys ** show ?thesis by force
next
case 2
with A(2) ys have "(i, j) ∈ arcs' xs"
using cycle_rotate_2_aux by (auto simp add: arcs'_def)
from cycle_rotate_len_arcs_successive'[OF ‹length xs > 1› this A(3,4), of M] show ?thesis
by auto
qed
qed
qed
qed
qed
end
Theory DBM_Basics
theory DBM_Basics
imports DBM Paths_Cycles
begin
fun get_const where
"get_const (Le c) = c" |
"get_const (Lt c) = c" |
"get_const ∞ = undefined"
subsection ‹Discourse on updating DBMs›
abbreviation DBM_update :: "('t::time) DBM ⇒ nat ⇒ nat ⇒ ('t DBMEntry) ⇒ ('t::time) DBM"
where
"DBM_update M m n v ≡ (λ x y. if m = x ∧ n = y then v else M x y)"
fun DBM_upd :: "('t::time) DBM ⇒ (nat ⇒ nat ⇒ 't DBMEntry) ⇒ nat ⇒ nat ⇒ nat ⇒ 't DBM"
where
"DBM_upd M f 0 0 _ = DBM_update M 0 0 (f 0 0)" |
"DBM_upd M f (Suc i) 0 n = DBM_update (DBM_upd M f i n n) (Suc i) 0 (f (Suc i) 0)" |
"DBM_upd M f i (Suc j) n = DBM_update (DBM_upd M f i j n) i (Suc j) (f i (Suc j))"
lemma upd_1:
assumes "j ≤ n"
shows "DBM_upd M1 f (Suc m) n N (Suc m) j = DBM_upd M1 f (Suc m) j N (Suc m) j"
using assms
by (induction n) auto
lemma upd_2:
assumes "i ≤ m"
shows "DBM_upd M1 f (Suc m) n N i j = DBM_upd M1 f (Suc m) 0 N i j"
using assms
proof (induction n)
case 0 thus ?case by blast
next
case (Suc n)
thus ?case by simp
qed
lemma upd_3:
assumes "m ≤ N" "n ≤ N" "j ≤ n" "i ≤ m"
shows "(DBM_upd M1 f m n N) i j = (DBM_upd M1 f i j N) i j"
using assms
proof (induction m arbitrary: n i j, goal_cases)
case (1 n) thus ?case by (induction n) auto
next
case (2 m n i j) thus ?case
proof (cases "i = Suc m")
case True thus ?thesis using upd_1[OF ‹j ≤ n›] by blast
next
case False
with ‹i ≤ Suc m› have "i ≤ m" by auto
with upd_2[OF this] have "DBM_upd M1 f (Suc m) n N i j = DBM_upd M1 f m N N i j" by force
also have "… = DBM_upd M1 f i j N i j" using False 2 by force
finally show ?thesis .
qed
qed
lemma upd_id:
assumes "m ≤ N" "n ≤ N" "i ≤ m" "j ≤ n"
shows "(DBM_upd M1 f m n N) i j = f i j"
proof -
from assms upd_3 have "DBM_upd M1 f m n N i j = DBM_upd M1 f i j N i j" by blast
also have "… = f i j" by (cases i; cases j; fastforce)
finally show ?thesis .
qed
subsection ‹Zones and DBMs›
definition DBM_zone_repr :: "('t::time) DBM ⇒ ('c ⇒ nat) ⇒ nat ⇒ ('c, 't :: time) zone"
("[_]⇘_,_⇙" [72,72,72] 72)
where
"[M]⇘v,n⇙ = {u . DBM_val_bounded v u M n}"
lemma dbm_entry_val_mono_1:
"dbm_entry_val u (Some c) (Some c') b ⟹ b ≼ b' ⟹ dbm_entry_val u (Some c) (Some c') b'"
proof (induction b, goal_cases)
case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
case 3 thus ?case unfolding dbm_le_def by auto
qed
lemma dbm_entry_val_mono_2:
"dbm_entry_val u None (Some c) b ⟹ b ≼ b' ⟹ dbm_entry_val u None (Some c) b'"
proof (induction b, goal_cases)
case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
case 3 thus ?case unfolding dbm_le_def by auto
qed
lemma dbm_entry_val_mono_3:
"dbm_entry_val u (Some c) None b ⟹ b ≼ b' ⟹ dbm_entry_val u (Some c) None b'"
proof (induction b, goal_cases)
case 1 thus ?case using le_dbm_le le_dbm_lt by (induction b'; fastforce)
next
case 2 thus ?case using lt_dbm_le lt_dbm_lt by (induction b'; fastforce)
next
case 3 thus ?case unfolding dbm_le_def by auto
qed
lemma DBM_le_subset:
"∀ i j. i ≤ n ⟶ j ≤ n ⟶ M i j ≼ M' i j ⟹ u ∈ [M]⇘v,n⇙ ⟹ u ∈ [M']⇘v,n⇙"
proof -
assume A: "∀i j. i ≤ n ⟶ j ≤ n ⟶ M i j ≼ M' i j" "u ∈ [M]⇘v,n⇙"
hence "DBM_val_bounded v u M n" by (simp add: DBM_zone_repr_def)
with A(1) have "DBM_val_bounded v u M' n" unfolding DBM_val_bounded_def
proof (auto, goal_cases)
case 1 from this(1,2) show ?case unfolding less_eq[symmetric] by fastforce
next
case (2 c)
hence "dbm_entry_val u None (Some c) (M 0 (v c))" "M 0 (v c) ≼ M' 0 (v c)" by auto
thus ?case using dbm_entry_val_mono_2 by fast
next
case (3 c)
hence "dbm_entry_val u (Some c) None (M (v c) 0)" "M (v c) 0 ≼ M' (v c) 0" by auto
thus ?case using dbm_entry_val_mono_3 by fast
next
case (4 c1 c2)
hence "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" "M (v c1) (v c2) ≼ M' (v c1) (v c2)"
by auto
thus ?case using dbm_entry_val_mono_1 by fast
qed
thus "u ∈ [M']⇘v,n⇙" by (simp add: DBM_zone_repr_def)
qed
subsection ‹DBMs Without Negative Cycles are Non-Empty›
text ‹
We need all of these assumptions for the proof that matrices without negative cycles
represent non-negative zones:
* Abelian (linearly ordered) monoid
* Time is non-trivial
* Time is dense
›
lemmas (in linordered_ab_monoid_add) comm = add.commute
lemma sum_gt_neutral_dest':
"(a :: (('a :: time) DBMEntry)) ≥ 𝟭 ⟹ a + b > 𝟭 ⟹ ∃ d. Le d ≤ a ∧ Le (-d) ≤ b ∧ d ≥ 0"
proof -
assume "a + b > 𝟭" "a ≥ 𝟭"
show ?thesis
proof (cases "b ≥ 𝟭")
case True
with ‹a ≥ 𝟭› show ?thesis by (auto simp: neutral)
next
case False
hence "b < Le 0" by (auto simp: neutral)
with ‹a ≥ 𝟭› ‹a + b > 𝟭› show ?thesis
proof (cases a, cases b, auto simp: neutral, goal_cases)
case (1 a' b')
from 1(2) have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
hence "b' > -a'" by (metis add.commute diff_0 diff_less_eq)
with ‹Le 0 ≤ Le a'› show ?case
by (auto simp: dbm_le_def less_eq le_dbm_le)
next
case (2 a' b')
from this(2) have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
hence "b' > -a'" by (metis add.commute diff_0 diff_less_eq)
with ‹Le 0 ≤ Le a'› show ?case
by (auto simp: dbm_le_def less_eq le_dbm_le)
next
case (3 a') thus ?case by (auto simp: dbm_le_def less_eq)
next
case (4 a')
thus ?case
proof (cases b, auto, goal_cases)
case (1 b')
have "b' < 0" using 1(2) by (metis dbm_lt.intros(3) less less_asym neqE)
from 1 have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
then have "-b' < a'" by (metis diff_0 diff_less_eq)
with ‹b' < 0› show ?case by (auto simp: dbm_le_def less_eq)
next
case (2 b')
then have A: "b' ≤ 0" "a' > 0" by (auto elim: dbm_lt.cases simp: less less_eq dbm_le_def)
show ?case
proof (cases "b' = 0")
case True
from dense[OF A(2)] obtain d where d: "d > 0" "d < a'" by auto
then have "Le (-d) < Lt b'" "Le d < Lt a'" unfolding less using True by auto
with d(1) show ?thesis by - (rule exI[where x = "d"], auto)
next
case False
with A(1) have *: "- b' > 0" by simp
from 2 have "a' + b' > 0" by (auto elim: dbm_lt.cases simp: less mult)
then have "-b' < a'" by (metis less_add_same_cancel1 minus_add_cancel minus_less_iff)
from dense[OF this] obtain d where d:
"d > -b'" "-d < b'" "d < a'"
by (auto simp add: minus_less_iff)
then have "Le (-d) < Lt b'" "Le d < Lt a'" unfolding less by auto
with d(1) * show ?thesis
by - (rule exI[where x = "d"], auto,
meson d(2) dual_order.order_iff_strict less_trans neg_le_0_iff_le)
qed
next
case 3 thus ?case by (auto simp: dbm_le_def less_eq)
qed
next
case 5 thus ?case
proof (cases b, auto, goal_cases)
case (1 b')
from this(2) have "-b' ≥ 0"
by (metis dbm_lt.intros(3) leI less less_asym neg_less_0_iff_less)
let ?d = "- b'"
have "Le ?d ≤ ∞" "Le (- ?d) ≤ Le b'" by (auto simp: any_le_inf)
with ‹-b' ≥ 0› show ?case by auto
next
case (2 b')
then have "b' ≤ 0" by (auto elim: dbm_lt.cases simp: less)
from non_trivial_neg obtain e :: 'a where e:"e < 0" by blast
let ?d = "- (b' + e)"
from e ‹b' ≤ 0› have "Le ?d ≤ ∞" "Le (- ?d) ≤ Lt b'" "b' + e < 0"
by (auto simp: dbm_lt.intros(4) less less_imp_le any_le_inf add_nonpos_neg)
then have "Le ?d ≤ ∞" "Le (- ?d) ≤ Lt b'" "?d ≥ 0"
using less_imp_le neg_0_le_iff_le by blast+
thus ?case by auto
qed
qed
qed
qed
lemma sum_gt_neutral_dest:
"(a :: (('a :: time) DBMEntry)) + b > 𝟭 ⟹ ∃ d. Le d ≤ a ∧ Le (-d) ≤ b"
proof -
assume A: "a + b > 𝟭"
then have A': "b + a > 𝟭" by (simp add: comm)
show ?thesis
proof (cases "a ≥ 𝟭")
case True
with A sum_gt_neutral_dest' show ?thesis by auto
next
case False
{ assume "b ≤ 𝟭"
with False have "a ≤ 𝟭" "b ≤ 𝟭" by auto
from add_mono[OF this] have "a + b ≤ 𝟭" by auto
with A have False by auto
}
then have "b ≥ 𝟭" by fastforce
with sum_gt_neutral_dest'[OF this A'] show ?thesis by auto
qed
qed
subsection ‹
Negative Cycles in DBMs
›
lemma DBM_val_bounded_neg_cycle1:
fixes i xs assumes
bounded: "DBM_val_bounded v u M n" and A:"i ≤ n" "set xs ⊆ {0..n}" "len M i i xs < 𝟭" and
surj_on: "∀ k ≤ n. k > 0 ⟶ (∃ c. v c = k)" and at_most: "i ≠ 0" "cnt 0 xs ≤ 1"
shows False
proof -
from A(1) surj_on at_most obtain c where c: "v c = i" by auto
with DBM_val_bounded_len'3[OF bounded at_most(2), of c c] A(1,2) surj_on
have bounded:"dbm_entry_val u (Some c) (Some c) (len M i i xs)" by force
from A(3) have "len M i i xs ≺ Le 0" by (simp add: neutral less)
then show False using bounded by (cases rule: dbm_lt.cases) (auto elim: dbm_entry_val.cases)
qed
lemma cnt_0_I:
"x ∉ set xs ⟹ cnt x xs = 0"
by (induction xs) auto
lemma distinct_cnt: "distinct xs ⟹ cnt x xs ≤ 1"
apply (induction xs)
apply simp
apply (rename_tac a xs)
apply (case_tac "x = a")
using cnt_0_I by fastforce+
lemma DBM_val_bounded_neg_cycle:
fixes i xs assumes
bounded: "DBM_val_bounded v u M n" and A:"i ≤ n" "set xs ⊆ {0..n}" "len M i i xs < 𝟭" and
surj_on: "∀ k ≤ n. k > 0 ⟶ (∃ c. v c = k)"
shows False
proof -
from negative_len_shortest[OF _ A(3)] obtain j ys where ys:
"distinct (j # ys)" "len M j j ys < 𝟭" "j ∈ set (i # xs)" "set ys ⊆ set xs"
by blast
show False
proof (cases "ys = []")
case True
show ?thesis
proof (cases "j = 0")
case True
with ‹ys = []› ys bounded show False unfolding DBM_val_bounded_def neutral less_eq[symmetric]
by auto
next
case False
with ‹ys = []› DBM_val_bounded_neg_cycle1[OF bounded _ _ ys(2) surj_on] ys(3) A(1,2)
show False by auto
qed
next
case False
from distinct_arcs_ex[OF _ _ this, of j 0 j] ys(1) obtain a b where arc:
"a ≠ 0" "(a, b) ∈ set (arcs j j ys)"
by auto
from cycle_rotate_2'[OF False this(2)] obtain zs where zs:
"len M j j ys = len M a a (b # zs)" "set (a # b # zs) = set (j # ys)"
"1 + length zs = length ys" "set (arcs j j ys) = set (arcs a a (b # zs))"
by blast
with distinct_card[OF ys(1)] have "distinct (a # b # zs)" by (intro card_distinct) auto
with distinct_cnt[of "b # zs"] have *: "cnt 0 (b # zs) ≤ 1" by fastforce
show ?thesis
apply (rule DBM_val_bounded_neg_cycle1[OF bounded _ _ _ surj_on ‹a ≠ 0› *])
using zs(2) ys(3,4) A(1,2) apply fastforce+
using zs(1) ys(2) by simp
qed
qed
subsection ‹Floyd-Warshall Algorithm Preservers Zones›
lemma D_dest: "x = D m i j k ⟹
x ∈ {len m i j xs |xs. set xs ⊆ {0..k} ∧ i ∉ set xs ∧ j ∉ set xs ∧ distinct xs}"
using Min_elem_dest[OF D_base_finite'' D_base_not_empty] by (fastforce simp add: D_def)
lemma FW_zone_equiv:
"∀ k ≤ n. k > 0 ⟶ (∃ c. v c = k) ⟹ [M]⇘v,n⇙ = [FW M n]⇘v,n⇙"
proof safe
fix u assume A: "u ∈ [FW M n]⇘v,n⇙"
{ fix i j assume "i ≤ n" "j ≤ n"
hence "FW M n i j ≤ M i j" using fw_mono[of n n n i j M n] by simp
hence "FW M n i j ≼ M i j" by (simp add: less_eq)
}
with DBM_le_subset[of n "FW M n" M] A show "u ∈ [M]⇘v,n⇙" by auto
next
fix u assume u:"u ∈ [M]⇘v,n⇙" and surj_on: "∀ k ≤ n. k > 0 ⟶ (∃ c. v c = k)"
hence *:"DBM_val_bounded v u M n" by (simp add: DBM_zone_repr_def)
note ** = DBM_val_bounded_neg_cycle[OF this _ _ _ surj_on]
have cyc_free: "cyc_free M n" using ** by fastforce
with cycle_free_diag_equiv have cycle_free: "cycle_free M n" by auto
from cycle_free_diag[OF this] have diag_ge_zero: "∀k≤n. M k k ≥ Le 0" unfolding neutral by auto
have "DBM_val_bounded v u (FW M n) n" unfolding DBM_val_bounded_def
proof (auto, goal_cases)
case 1
from fw_shortest_path[OF cycle_free, of 0 n 0 n n] have **:
"D M 0 0 n = FW M n 0 0"
by (simp add: neutral)
from D_dest[OF **[symmetric]] obtain xs where xs:
"FW M n 0 0 = len M 0 0 xs" "set xs ⊆ {0..n}"
"0 ∉ set xs" "distinct xs"
by auto
with cyc_free have "FW M n 0 0 ≥ 𝟭" by auto
then show ?case unfolding neutral less_eq by simp
next
case (2 c)
with fw_shortest_path[OF cycle_free, of 0 n "v c" n n] have **:
"D M 0 (v c) n = FW M n 0 (v c)"
by (simp add: neutral)
from D_dest[OF **[symmetric]] obtain xs where xs:
"FW M n 0 (v c) = len M 0 (v c) xs" "set xs ⊆ {0..n}"
"0 ∉ set xs" "v c ∉ set xs" "distinct xs"
by auto
show ?case unfolding xs(1) using xs surj_on ‹v c ≤ n›
by - (rule DBM_val_bounded_len'2[OF * xs(3)]; auto)
next
case (3 c)
with fw_shortest_path[OF cycle_free, of "v c" n 0 n n] have **:
"D M (v c) 0 n = FW M n (v c) 0"
by (simp add: neutral)
with D_dest[OF **[symmetric]] obtain xs where xs:
"FW M n (v c) 0 = len M (v c) 0 xs" "set xs ⊆ {0..n}"
"0 ∉ set xs" "v c ∉ set xs" "distinct xs"
by auto
show ?case unfolding xs(1) using xs surj_on ‹v c ≤ n›
by - (rule DBM_val_bounded_len'1[OF * xs(3)]; auto)
next
case (4 c1 c2)
with fw_shortest_path[OF cycle_free, of "v c1" n "v c2" n n]
have "D M (v c1) (v c2) n = FW M n (v c1) (v c2)" by (simp add: neutral)
from D_dest[OF this[symmetric]] obtain xs where xs:
"FW M n (v c1) (v c2) = len M (v c1) (v c2) xs" "set xs ⊆ {0..n}"
"v c1 ∉ set xs" "v c2 ∉ set xs" "distinct xs"
by auto
show ?case
unfolding xs(1)
apply (rule DBM_val_bounded_len'3[OF *])
using xs surj_on ‹v c1 ≤ n› ‹v c2 ≤ n› apply auto
apply (drule distinct_cnt[of _ 0])
by auto
qed
then show "u ∈ [FW M n]⇘v,n⇙" unfolding DBM_zone_repr_def by simp
qed
lemma new_negative_cycle_aux':
fixes M :: "('a :: time) DBM"
fixes i j d
defines "M' ≡ λ i' j'. if (i' = i ∧ j' = j) then Le d
else if (i' = j ∧ j' = i) then Le (-d)
else M i' j'"
assumes "i ≤ n" "j ≤ n" "set xs ⊆ {0..n}" "cycle_free M n" "length xs = m"
assumes "len M' i i (j # xs) < 𝟭 ∨ len M' j j (i # xs) < 𝟭"
assumes "i ≠ j"
shows "∃xs. set xs ⊆ {0..n} ∧ j ∉ set xs ∧ i ∉ set xs
∧ (len M' i i (j # xs) < 𝟭 ∨ len M' j j (i # xs) < 𝟭)" using assms
proof (induction _ m arbitrary: xs rule: less_induct)
case (less x)
{ fix b a xs assume A: "(i, j) ∉ set (arcs b a xs)" "(j, i) ∉ set (arcs b a xs)"
with ‹i ≠ j› have "len M' b a xs = len M b a xs"
unfolding M'_def by (induction xs arbitrary: b) auto
} note * = this
{ fix a xs assume A:"(i, j) ∉ set (arcs a a xs)" "(j, i) ∉ set (arcs a a xs)"
assume a: "a ≤ n" and xs: "set xs ⊆ {0..n}" and cycle: "¬ len M' a a xs ≥ 𝟭"
from *[OF A] have "len M' a a xs = len M a a xs" .
with ‹cycle_free M n› ‹i ≤ n› cycle xs a have False unfolding cycle_free_def by auto
} note ** = this
{ fix a :: nat fix ys :: "nat list"
assume A: "ys ≠ []" "length ys ≤ length xs" "set ys ⊆ set xs" "a ≤ n"
assume cycle: "len M' a a ys < 𝟭"
assume arcs: "(i, j) ∈ set (arcs a a ys) ∨ (j, i) ∈ set (arcs a a ys)"
from arcs have ?thesis
proof
assume "(i, j) ∈ set (arcs a a ys)"
from cycle_rotate_2[OF ‹ys ≠ []› this, of M']
obtain ws where ws: "len M' a a ys = len M' i i (j # ws)" "set ws ⊆ set (a # ys)"
"length ws < length ys" by auto
with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
show ?thesis by fastforce
next
assume "(j, i) ∈ set (arcs a a ys)"
from cycle_rotate_2[OF ‹ys ≠ []› this, of M']
obtain ws where ws: "len M' a a ys = len M' j j (i # ws)" "set ws ⊆ set (a # ys)"
"length ws < length ys" by auto
with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
show ?thesis by fastforce
qed
} note *** = this
{ fix a :: nat fix ys :: "nat list"
assume A: "ys ≠ []" "length ys ≤ length xs" "set ys ⊆ set xs" "a ≤ n"
assume cycle: "¬ len M' a a ys ≥ 𝟭"
with A **[of a ys] less.prems
have "(i, j) ∈ set (arcs a a ys) ∨ (j, i) ∈ set (arcs a a ys)" by auto
with ***[OF A] cycle have ?thesis by auto
} note neg_cycle_IH = this
from cycle_free_diag[OF ‹cycle_free M n›] have "∀i. i ≤ n ⟶ Le 0 ≤ M i i" unfolding neutral by auto
then have M'_diag: "∀i. i ≤ n ⟶ Le 0 ≤ M' i i" unfolding M'_def using ‹i ≠ j› by auto
from less(8) show ?thesis
proof standard
assume cycle:"len M' i i (j # xs) < 𝟭"
show ?thesis
proof (cases "i ∈ set xs")
case False
then show ?thesis
proof (cases "j ∈ set xs")
case False
with ‹i ∉ set xs› show ?thesis using less.prems(3,6) by auto
next
case True
then obtain ys zs where ys_zs: "xs = ys @ j # zs" by (meson split_list)
with len_decomp[of "j # xs" "j # ys" j zs M' i i]
have len: "len M' i i (j # xs) = M' i j + len M' j j ys + len M' j i zs" by auto
show ?thesis
proof (cases "len M' j j ys ≥ 𝟭")
case True
have "len M' i i (j # zs) = M' i j + len M' j i zs" by simp
also from len True have "M' i j + len M' j i zs ≤ len M' i i (j # xs)"
by (metis add_le_impl add_lt_neutral comm not_le)
finally have cycle': "len M' i i (j # zs) < 𝟭" using cycle by auto
from ys_zs less.prems(5) have "x > length zs" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
show ?thesis by auto
next
case False
with M'_diag less.prems have "ys ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
case True
then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
with len_decomp[of "j # xs" "j # ys" i zs M' i i]
have len: "len M' i i (j # xs) = M' i j + len M' j i ys + len M' i i zs" by auto
show ?thesis
proof (cases "len M' i i zs ≥ 𝟭")
case True
have "len M' i i (j # ys) = M' i j + len M' j i ys" by simp
also from len True have "M' i j + len M' j i ys ≤ len M' i i (j # xs)"
by (metis add_lt_neutral comm not_le)
finally have cycle': "len M' i i (j # ys) < 𝟭" using cycle by auto
from ys_zs less.prems(5) have "x > length ys" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
show ?thesis by auto
next
case False
with less.prems(1,7) M'_diag have "zs ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
assume cycle:"len M' j j (i # xs) < 𝟭"
show ?thesis
proof (cases "j ∈ set xs")
case False
then show ?thesis
proof (cases "i ∈ set xs")
case False
with ‹j ∉ set xs› show ?thesis using less.prems(3,6) by auto
next
case True
then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
with len_decomp[of "i # xs" "i # ys" i zs M' j j]
have len: "len M' j j (i # xs) = M' j i + len M' i i ys + len M' i j zs" by auto
show ?thesis
proof (cases "len M' i i ys ≥ 𝟭")
case True
have "len M' j j (i # zs) = M' j i + len M' i j zs" by simp
also from len True have "M' j i + len M' i j zs ≤ len M' j j (i # xs)"
by (metis add_le_impl add_lt_neutral comm not_le)
finally have cycle': "len M' j j (i # zs) < 𝟭" using cycle by auto
from ys_zs less.prems(5) have "x > length zs" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
show ?thesis by auto
next
case False
with less.prems M'_diag have "ys ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
case True
then obtain ys zs where ys_zs: "xs = ys @ j # zs" by (meson split_list)
with len_decomp[of "i # xs" "i # ys" j zs M' j j]
have len: "len M' j j (i # xs) = M' j i + len M' i j ys + len M' j j zs" by auto
show ?thesis
proof (cases "len M' j j zs ≥ 𝟭")
case True
have "len M' j j (i # ys) = M' j i + len M' i j ys" by simp
also from len True have "M' j i + len M' i j ys ≤ len M' j j (i # xs)"
by (metis add_lt_neutral comm not_le)
finally have cycle': "len M' j j (i # ys) < 𝟭" using cycle by auto
from ys_zs less.prems(5) have "x > length ys" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
show ?thesis by auto
next
case False
with less.prems(2,7) M'_diag have "zs ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
qed
qed
lemma new_negative_cycle_aux:
fixes M :: "('a :: time) DBM"
fixes i d
defines "M' ≡ λ i' j'. if (i' = i ∧ j' = 0) then Le d
else if (i' = 0 ∧ j' = i) then Le (-d)
else M i' j'"
assumes "i ≤ n" "set xs ⊆ {0..n}" "cycle_free M n" "length xs = m"
assumes "len M' 0 0 (i # xs) < 𝟭 ∨ len M' i i (0 # xs) < 𝟭"
assumes "i ≠ 0"
shows "∃xs. set xs ⊆ {0..n} ∧ 0 ∉ set xs ∧ i ∉ set xs
∧ (len M' 0 0 (i # xs) < 𝟭 ∨ len M' i i (0 # xs) < 𝟭)" using assms
proof (induction _ m arbitrary: xs rule: less_induct)
case (less x)
{ fix b a xs assume A: "(0, i) ∉ set (arcs b a xs)" "(i, 0) ∉ set (arcs b a xs)"
then have "len M' b a xs = len M b a xs"
unfolding M'_def by (induction xs arbitrary: b) auto
} note * = this
{ fix a xs assume A:"(0, i) ∉ set (arcs a a xs)" "(i, 0) ∉ set (arcs a a xs)"
assume a: "a ≤ n" and xs: "set xs ⊆ {0..n}" and cycle: "¬ len M' a a xs ≥ 𝟭"
from *[OF A] have "len M' a a xs = len M a a xs" .
with ‹cycle_free M n› ‹i ≤ n› cycle xs a have False unfolding cycle_free_def by auto
} note ** = this
{ fix a :: nat fix ys :: "nat list"
assume A: "ys ≠ []" "length ys ≤ length xs" "set ys ⊆ set xs" "a ≤ n"
assume cycle: "len M' a a ys < 𝟭"
assume arcs: "(0, i) ∈ set (arcs a a ys) ∨ (i, 0) ∈ set (arcs a a ys)"
from arcs have ?thesis
proof
assume "(0, i) ∈ set (arcs a a ys)"
from cycle_rotate_2[OF ‹ys ≠ []› this, of M']
obtain ws where ws: "len M' a a ys = len M' 0 0 (i # ws)" "set ws ⊆ set (a # ys)"
"length ws < length ys" by auto
with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
show ?thesis by fastforce
next
assume "(i, 0) ∈ set (arcs a a ys)"
from cycle_rotate_2[OF ‹ys ≠ []› this, of M']
obtain ws where ws: "len M' a a ys = len M' i i (0 # ws)" "set ws ⊆ set (a # ys)"
"length ws < length ys" by auto
with cycle less.hyps(1)[OF _ less.hyps(2) , of "length ws" ws] less.prems A
show ?thesis by fastforce
qed
} note *** = this
{ fix a :: nat fix ys :: "nat list"
assume A: "ys ≠ []" "length ys ≤ length xs" "set ys ⊆ set xs" "a ≤ n"
assume cycle: "¬ len M' a a ys ≥ 𝟭"
with A **[of a ys] less.prems(2)
have "(0, i) ∈ set (arcs a a ys) ∨ (i, 0) ∈ set (arcs a a ys)" by auto
with ***[OF A] cycle have ?thesis by auto
} note neg_cycle_IH = this
from cycle_free_diag[OF ‹cycle_free M n›] have "∀i. i ≤ n ⟶ Le 0 ≤ M i i" unfolding neutral by auto
then have M'_diag: "∀i. i ≤ n ⟶ Le 0 ≤ M' i i" unfolding M'_def using ‹i ≠ 0› by auto
from less(7) show ?thesis
proof standard
assume cycle:"len M' 0 0 (i # xs) < 𝟭"
show ?thesis
proof (cases "0 ∈ set xs")
case False
thus ?thesis
proof (cases "i ∈ set xs")
case False
with ‹0 ∉ set xs› show ?thesis using less.prems by auto
next
case True
then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
with len_decomp[of "i # xs" "i # ys" i zs M' 0 0]
have len: "len M' 0 0 (i # xs) = M' 0 i + len M' i i ys + len M' i 0 zs" by auto
show ?thesis
proof (cases "len M' i i ys ≥ 𝟭")
case True
have "len M' 0 0 (i # zs) = M' 0 i + len M' i 0 zs" by simp
also from len True have "M' 0 i + len M' i 0 zs ≤ len M' 0 0 (i # xs)"
by (metis add_le_impl add_lt_neutral comm not_le)
finally have cycle': "len M' 0 0 (i # zs) < 𝟭" using cycle by auto
from ys_zs less.prems(4) have "x > length zs" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
show ?thesis by auto
next
case False
with less.prems(1,6) M'_diag have "ys ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
case True
then obtain ys zs where ys_zs: "xs = ys @ 0 # zs" by (meson split_list)
with len_decomp[of "i # xs" "i # ys" 0 zs M' 0 0]
have len: "len M' 0 0 (i # xs) = M' 0 i + len M' i 0 ys + len M' 0 0 zs" by auto
show ?thesis
proof (cases "len M' 0 0 zs ≥ 𝟭")
case True
have "len M' 0 0 (i # ys) = M' 0 i + len M' i 0 ys" by simp
also from len True have "M' 0 i + len M' i 0 ys ≤ len M' 0 0 (i # xs)"
by (metis add_lt_neutral comm not_le)
finally have cycle': "len M' 0 0 (i # ys) < 𝟭" using cycle by auto
from ys_zs less.prems(4) have "x > length ys" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
show ?thesis by auto
next
case False
with less.prems(1,6) M'_diag have "zs ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
assume cycle: "len M' i i (0 # xs) < 𝟭"
show ?thesis
proof (cases "i ∈ set xs")
case False
thus ?thesis
proof (cases "0 ∈ set xs")
case False
with ‹i ∉ set xs› show ?thesis using less.prems by auto
next
case True
then obtain ys zs where ys_zs: "xs = ys @ 0 # zs" by (meson split_list)
with len_decomp[of "0 # xs" "0 # ys" 0 zs M' i i]
have len: "len M' i i (0 # xs) = M' i 0 + len M' 0 0 ys + len M' 0 i zs" by auto
show ?thesis
proof (cases "len M' 0 0 ys ≥ 𝟭")
case True
have "len M' i i (0 # zs) = M' i 0 + len M' 0 i zs" by simp
also from len True have "M' i 0 + len M' 0 i zs ≤ len M' i i (0 # xs)"
by (metis add_le_impl add_lt_neutral comm not_le)
finally have cycle': "len M' i i (0 # zs) < 𝟭" using cycle by auto
from ys_zs less.prems(4) have "x > length zs" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of zs]
show ?thesis by auto
next
case False
with less.prems(1,6) M'_diag have "ys ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
next
case True
then obtain ys zs where ys_zs: "xs = ys @ i # zs" by (meson split_list)
with len_decomp[of "0 # xs" "0 # ys" i zs M' i i]
have len: "len M' i i (0 # xs) = M' i 0 + len M' 0 i ys + len M' i i zs" by auto
show ?thesis
proof (cases "len M' i i zs ≥ 𝟭")
case True
have "len M' i i (0 # ys) = M' i 0 + len M' 0 i ys" by simp
also from len True have "M' i 0 + len M' 0 i ys ≤ len M' i i (0 # xs)"
by (metis add_lt_neutral comm not_le)
finally have cycle': "len M' i i (0 # ys) < 𝟭" using cycle by auto
from ys_zs less.prems(4) have "x > length ys" by auto
from cycle' less.prems ys_zs less.hyps(1)[OF this less.hyps(2) , of ys]
show ?thesis by auto
next
case False
with less.prems(1,6) M'_diag have "zs ≠ []" by (auto simp: neutral)
from neg_cycle_IH[OF this] ys_zs False less.prems(1,2) show ?thesis by auto
qed
qed
qed
qed
section ‹The Characteristic Property of Canonical DBMs›
theorem fix_index':
fixes M :: "(('a :: time) DBMEntry) mat"
assumes "Le r ≤ M i j" "Le (-r) ≤ M j i" "cycle_free M n" "canonical M n" "i ≤ n" "j ≤ n" "i ≠ j"
defines "M' ≡ λ i' j'. if (i' = i ∧ j' = j) then Le r
else if (i' = j ∧ j' = i) then Le (-r)
else M i' j'"
shows "(∀ u. DBM_val_bounded v u M' n ⟶ DBM_val_bounded v u M n) ∧ cycle_free M' n"
proof -
note A = assms
note r = assms(1,2)
from ‹cycle_free M n› have diag_cycles: "∀i xs. i ≤ n ∧ set xs ⊆ {0..n} ⟶ Le 0 ≤ len M i i xs"
unfolding cycle_free_def neutral by auto
let ?M' = "λ i' j'. if (i' = i ∧ j' = j) then Le r
else if (i' = j ∧ j' = i) then Le (-r)
else M i' j'"
have "?M' i' j' ≤ M i' j'" when "i' ≤ n" "j' ≤ n" for i' j' using assms by auto
with DBM_le_subset[folded less_eq, of n ?M' M] have "DBM_val_bounded v u M n"
if "DBM_val_bounded v u ?M' n" for u unfolding DBM_zone_repr_def using that by auto
then have not_empty:"∀ u. DBM_val_bounded v u ?M' n ⟶ DBM_val_bounded v u M n" by auto
{ fix a xs assume prems: "a ≤ n" "set xs ⊆ {0..n}" and cycle: "¬ len ?M' a a xs ≥ 𝟭"
{ fix b assume A: "(i, j) ∉ set (arcs b a xs)" "(j, i) ∉ set (arcs b a xs)"
with ‹i ≠ j› have "len ?M' b a xs = len M b a xs" by (induction xs arbitrary: b) auto
} note * = this
{ fix a b xs assume A: "i ∉ set (a # xs)" "j ∉ set (a # xs)"
then have "len ?M' a b xs = len M a b xs" by (induction xs arbitrary: a, auto)
} note ** = this
{ assume A:"(i, j) ∉ set (arcs a a xs)" "(j, i) ∉ set (arcs a a xs)"
from *[OF this] have "len ?M' a a xs = len M a a xs" .
with ‹cycle_free M n› prems cycle have False by (auto simp: cycle_free_def)
}
then have arcs:"(i, j) ∈ set (arcs a a xs) ∨ (j, i) ∈ set (arcs a a xs)" by auto
with ‹i ≠ j› have "xs ≠ []" by auto
from arcs obtain xs where xs: "set xs ⊆ {0..n}"
"len ?M' i i (j # xs) < 𝟭 ∨ len ?M' j j (i # xs) < 𝟭"
proof (standard, goal_cases)
case 1
from cycle_rotate_2'[OF ‹xs ≠ []› this(2), of ?M'] prems obtain ys where
"len ?M' i i (j # ys) = len ?M' a a xs" "set ys ⊆ {0..n}"
by fastforce
with 1 cycle show ?thesis by fastforce
next
case 2
from cycle_rotate_2'[OF ‹xs ≠ []› this(2), of ?M'] prems obtain ys where
"len ?M' j j (i # ys) = len ?M' a a xs" "set ys ⊆ {0..n}"
by fastforce
with 2 cycle show ?thesis by fastforce
qed
from new_negative_cycle_aux'[OF ‹i ≤ n› ‹j ≤ n› this(1) ‹cycle_free M n› _ this(2) ‹i ≠ j›]
obtain xs where xs:
"set xs ⊆ {0..n}" "i ∉ set xs" "j ∉ set xs"
"len ?M' i i (j # xs) < 𝟭 ∨ len ?M' j j (i # xs) < 𝟭"
by auto
from this(4) have False
proof
assume A: "len ?M' j j (i # xs) < 𝟭"
show False
proof (cases xs)
case Nil
with ‹i ≠ j› have *:"?M' j i = Le (-r)" "?M' i j = Le r" by simp+
from Nil have "len ?M' j j (i # xs) = ?M' j i + ?M' i j" by simp
with * have "len ?M' j j (i # xs) = Le 0" by (simp add: mult)
then show False using A by (simp add: neutral)
next
case (Cons y ys)
have *:"M i y + M y j ≥ M i j"
using ‹canonical M n› Cons xs ‹i ≤ n› ‹j ≤ n› by (simp add: mult less_eq)
have "Le 0 = Le (-r) + Le r" by (simp add: mult)
also have "… ≤ Le (-r) + M i j" using r by (simp add: add_mono)
also have "… ≤ Le (-r) + M i y + M y j" using * by (simp add: add_mono assoc)
also have "… ≤ Le (-r) + ?M' i y + len M y j ys"
using canonical_len[OF ‹canonical M n›] xs(1-3) ‹i ≤ n› ‹j ≤ n› Cons by (simp add: add_mono)
also have "… = len ?M' j j (i # xs)" using Cons ‹i ≠ j› ** xs(1-3) by (simp add: assoc)
also have "… < Le 0" using A by (simp add: neutral)
finally show False by simp
qed
next
assume A: "len ?M' i i (j # xs) < 𝟭"
show False
proof (cases xs)
case Nil
with ‹i ≠ j› have *:"?M' j i = Le (-r)" "?M' i j = Le r" by simp+
from Nil have "len ?M' i i (j # xs) = ?M' i j + ?M' j i" by simp
with * have "len ?M' i i (j # xs) = Le 0" by (simp add: mult)
then show False using A by (simp add: neutral)
next
case (Cons y ys)
have *:"M j y + M y i ≥ M j i"
using ‹canonical M n› Cons xs ‹i ≤ n› ‹j ≤ n› by (simp add: mult less_eq)
have "Le 0 = Le r + Le (-r)" by (simp add: mult)
also have "… ≤ Le r + M j i" using r by (simp add: add_mono)
also have "… ≤ Le r + M j y + M y i" using * by (simp add: add_mono assoc)
also have "… ≤ Le r + ?M' j y + len M y i ys"
using canonical_len[OF ‹canonical M n›] xs(1-3) ‹i ≤ n› ‹j ≤ n› Cons by (simp add: add_mono)
also have "… = len ?M' i i (j # xs)" using Cons ‹i ≠ j› ** xs(1-3) by (simp add: assoc)
also have "… < Le 0" using A by (simp add: neutral)
finally show False by simp
qed
qed
} note * = this
have "cycle_free ?M' n" using negative_cycle_dest_diag * by fastforce
then show ?thesis using not_empty ‹i ≠ j› r unfolding M'_def by auto
qed
lemma fix_index:
fixes M :: "(('a :: time) DBMEntry) mat"
assumes "M 0 i + M i 0 > 𝟭" "cycle_free M n" "canonical M n" "i ≤ n" "i ≠ 0"
shows
"∃ (M' :: ('a DBMEntry) mat). ((∃ u. DBM_val_bounded v u M' n) ⟶ (∃ u. DBM_val_bounded v u M n))
∧ M' 0 i + M' i 0 = 𝟭 ∧ cycle_free M' n
∧ (∀ j. i ≠ j ∧ M 0 j + M j 0 = 𝟭 ⟶ M' 0 j + M' j 0 = 𝟭)
∧ (∀ j. i ≠ j ∧ M 0 j + M j 0 > 𝟭 ⟶ M' 0 j + M' j 0 > 𝟭)"
proof -
note A = assms
from sum_gt_neutral_dest[OF assms(1)] obtain d where d: "Le d ≤ M i 0" "Le (-d) ≤ M 0 i" by auto
have "i ≠ 0" using A by - (rule ccontr; simp)
let ?M' = "λi' j'. if i' = i ∧ j' = 0 then Le d else if i' = 0 ∧ j' = i then Le (-d) else M i' j'"
from fix_index'[OF d(1,2) A(2,3,4) _ ‹i ≠ 0›] have M':
"∀u. DBM_val_bounded v u ?M' n ⟶ DBM_val_bounded v u M n" "cycle_free ?M' n"
by auto
moreover from ‹i ≠ 0› have "∀ j. i ≠ j ∧ M 0 j + M j 0 = 𝟭 ⟶ ?M' 0 j + ?M' j 0 = 𝟭" by auto
moreover from ‹i ≠ 0› have "∀ j. i ≠ j ∧ M 0 j + M j 0 > 𝟭 ⟶ ?M' 0 j + ?M' j 0 > 𝟭" by auto
moreover from ‹i ≠ 0› have "?M' 0 i + ?M' i 0 = 𝟭" unfolding neutral mult by auto
ultimately show ?thesis by blast
qed
subsubsection ‹
Putting it together
›
lemma FW_not_empty:
"DBM_val_bounded v u (FW M' n) n ⟹ DBM_val_bounded v u M' n"
proof -
assume A: "DBM_val_bounded v u (FW M' n) n"
have "∀i j. i ≤ n ⟶ j ≤ n ⟶ FW M' n i j ≤ M' i j" using fw_mono by blast
from DBM_le_subset[of n "FW M' n" M' _ v, OF this[unfolded less_eq]]
show "DBM_val_bounded v u M' n" using A by (auto simp: DBM_zone_repr_def)
qed
lemma fix_indices:
fixes M :: "(('a :: time) DBMEntry) mat"
assumes "set xs ⊆ {0..n}" "distinct xs"
assumes "cyc_free M n" "canonical M n"
shows
"∃ (M' :: ('a DBMEntry) mat). ((∃ u. DBM_val_bounded v u M' n) ⟶ (∃ u. DBM_val_bounded v u M n))
∧ (∀ i ∈ set xs. i ≠ 0 ⟶ M' 0 i + M' i 0 = 𝟭) ∧ cyc_free M' n
∧ (∀ i≤n. i ∉ set xs ∧ M 0 i + M i 0 = 𝟭 ⟶ M' 0 i + M' i 0 = 𝟭)" using assms
proof (induction xs arbitrary: M)
case Nil then show ?case by auto
next
case (Cons i xs)
show ?case
proof (cases "M 0 i + M i 0 ≤ 𝟭 ∨ i = 0")
case True
note T = this
show ?thesis
proof (cases "i = 0")
case False
from Cons.prems have "0 ≤ n" "set [i] ⊆ {0..n}" by auto
with Cons.prems(3) False T have "M 0 i + M i 0 = 𝟭" by fastforce
with Cons.IH[OF _ _ Cons.prems(3,4)] Cons.prems(1,2) show ?thesis by auto
next
case True
with Cons.IH[OF _ _ Cons.prems(3,4)] Cons.prems(1,2) show ?thesis by auto
qed
next
case False
with Cons.prems have "𝟭 < M 0 i + M i 0" "i ≤ n" "i ≠ 0" by auto
with fix_index[OF this(1) cycle_free_diag_intro[OF Cons.prems(3)] Cons.prems(4) this(2,3), of v]
obtain M' :: "('a DBMEntry) mat" where M':
"((∃u. DBM_val_bounded v u M' n) ⟶ (∃u. DBM_val_bounded v u M n))" "(M' 0 i + M' i 0 = 𝟭)"
"cyc_free M' n" "∀j≤n. i ≠ j ∧ M 0 j + M j 0 > 𝟭 ⟶ M' 0 j + M' j 0 > 𝟭"
"∀j. i ≠ j ∧ M 0 j + M j 0 = 𝟭 ⟶ M' 0 j + M' j 0 = 𝟭"
using cycle_free_diag_equiv by blast
let ?M' = "FW M' n"
from fw_canonical[of M' n] cycle_free_diag_equiv ‹cyc_free M' n› have "canonical ?M' n" by auto
from FW_cyc_free_preservation[OF ‹cyc_free M' n›] have "cyc_free ?M' n"
by auto
from FW_fixed_preservation[OF ‹i ≤ n› M'(2) ‹canonical ?M' n› ‹cyc_free ?M' n›]
have fixed:"?M' 0 i + ?M' i 0 = 𝟭" by (auto simp: add_mono)
from Cons.IH[OF _ _ ‹cyc_free ?M' n› ‹canonical ?M' n›] Cons.prems(1,2,3)
obtain M'' :: "('a DBMEntry) mat"
where M'': "((∃u. DBM_val_bounded v u M'' n) ⟶ (∃u. DBM_val_bounded v u ?M' n))"
"(∀i∈set xs. i ≠ 0 ⟶ M'' 0 i + M'' i 0 = 𝟭)" "cyc_free M'' n"
"(∀i≤n. i ∉ set xs ∧ ?M' 0 i + ?M' i 0 = 𝟭 ⟶ M'' 0 i + M'' i 0 = 𝟭)"
by auto
from FW_fixed_preservation[OF _ _ ‹canonical ?M' n› ‹cyc_free ?M' n›] M'(5)
have "∀j≤n. i ≠ j ∧ M 0 j + M j 0 = 𝟭 ⟶ ?M' 0 j + ?M' j 0 = 𝟭" by auto
with M''(4) have "∀j≤n. j ∉ set (i # xs) ∧ M 0 j + M j 0 = 𝟭 ⟶ M'' 0 j + M'' j 0 = 𝟭" by auto
moreover from M''(2) M''(4) fixed Cons.prems(2) ‹i ≤ n›
have "(∀i∈set (i#xs). i ≠ 0 ⟶ M'' 0 i + M'' i 0 = 𝟭)" by auto
moreover from M''(1) M'(1) FW_not_empty[of v _ M' n]
have "(∃u. DBM_val_bounded v u M'' n) ⟶ (∃u. DBM_val_bounded v u M n)" by auto
ultimately show ?thesis using ‹cyc_free M'' n› M''(4) by auto
qed
qed
lemma cyc_free_obtains_valuation:
"cyc_free M n ⟹ ∀ c. v c ≤ n ⟶ v c > 0 ⟹ ∃ u. DBM_val_bounded v u M n"
proof -
assume A: "cyc_free M n" "∀ c. v c ≤ n ⟶ v c > 0"
let ?M = "FW M n"
from fw_canonical[of M n] cycle_free_diag_equiv A have "canonical ?M n" by auto
from FW_cyc_free_preservation[OF A(1) ] have "cyc_free ?M n" .
have "set [0..<n+1] ⊆ {0..n}" "distinct [0..<n+1]" by auto
from fix_indices[OF this ‹cyc_free ?M n› ‹canonical ?M n›]
obtain M' :: "('a DBMEntry) mat" where M':
"(∃u. DBM_val_bounded v u M' n) ⟶ (∃u. DBM_val_bounded v u (FW M n) n)"
"∀i∈set [0..<n + 1]. i ≠ 0 ⟶ M' 0 i + M' i 0 = 𝟭" "cyc_free M' n"
by blast
let ?M' = "FW M' n"
have "⋀ i. i ≤ n ⟹ i ∈ set [0..<n + 1]" by auto
with M'(2) have M'_fixed: "∀i≤n. i ≠ 0 ⟶ M' 0 i + M' i 0 = 𝟭" by fastforce
from fw_canonical[of M' n] cycle_free_diag_equiv M'(3) have "canonical ?M' n" by blast
from FW_fixed_preservation[OF _ _ this FW_cyc_free_preservation[OF M'(3)]] M'_fixed
have fixed: "∀i≤n. i ≠ 0 ⟶ ?M' 0 i + ?M' i 0 = 𝟭" by auto
have *: "⋀i. i ≤ n ⟹ i ≠ 0 ⟹ ∃ d. ?M' 0 i = Le (-d) ∧ ?M' i 0 = Le d"
proof -
fix i assume i: "i ≤ n" "i ≠ 0"
from i fixed have *:"dbm_add (?M' 0 i) (?M' i 0) = Le 0" by (auto simp add: mult neutral)
moreover
{ fix a b :: 'a assume "a + b = 0"
then have "a = -b" by (simp add: eq_neg_iff_add_eq_0)
}
ultimately show "∃d. ?M' 0 i = Le (-d) ∧ ?M' i 0 = Le d"
by (cases "?M' 0 i"; cases "?M' i 0"; simp)
qed
then obtain f where f: "∀ i≤n. i ≠ 0 ⟶ Le (f i) = ?M' i 0 ∧ Le (- f i) = ?M' 0 i" by metis
let ?u = "λ c. f (v c)"
have "DBM_val_bounded v ?u ?M' n"
proof (auto simp add: DBM_val_bounded_def, goal_cases)
case 1
from cyc_free_diag_dest'[OF FW_cyc_free_preservation[OF M'(3)]] show ?case
unfolding neutral less_eq by fast
next
case (2 c)
with A(2) have **: "v c > 0" by auto
with *[OF 2] obtain d where d: "Le (-d) = ?M' 0 (v c)" by auto
with f 2 ** have "Le (- f (v c)) = Le (- d)" by simp
then have "- f (v c) ≤ - d" by auto
from dbm_entry_val.intros(2)[of ?u , OF this] d
show ?case by auto
next
case (3 c)
with A(2) have **: "v c > 0" by auto
with *[OF 3] obtain d where d: "Le d = ?M' (v c) 0" by auto
with f 3 ** have "Le (f (v c)) = Le d" by simp
then have "f (v c) ≤ d" by auto
from dbm_entry_val.intros(1)[of ?u, OF this] d
show ?case by auto
next
case (4 c1 c2)
with A(2) have **: "v c1 > 0" "v c2 > 0" by auto
with *[OF 4(1)] obtain d1 where d1: "Le d1 = ?M' (v c1) 0" by auto
with f 4 ** have "Le (f (v c1)) = Le d1" by simp
then have d1': "f (v c1) = d1" by auto
from *[OF 4(2)] ** obtain d2 where d2: "Le d2 = ?M' (v c2) 0" by auto
with f 4 ** have "Le (f (v c2)) = Le d2" by simp
then have d2': "f (v c2) = d2" by auto
have "Le d1 ≤ ?M' (v c1) (v c2) + Le d2" using ‹canonical ?M' n› 4 d1 d2
by (auto simp add: less_eq mult)
then show ?case
proof (cases "?M' (v c1) (v c2)", auto, goal_cases)
case (1 d)
from this(1) have "d1 ≤ d + d2" by (auto simp: mult less_eq le_dbm_le)
then have "d1 - d2 ≤ d" by (simp add: diff_le_eq)
then show ?case using d1' d2' by auto
next
case (2 d)
from this(1) have "d1 < d + d2" by (auto simp: mult less_eq dbm_le_def elim: dbm_lt.cases)
then have "d1 - d2 < d" using diff_less_eq by blast
then show ?case using d1' d2' by auto
qed
qed
from M'(1) FW_not_empty[OF this] obtain u where "DBM_val_bounded v u ?M n" by auto
from FW_not_empty[OF this] show ?thesis by auto
qed
subsection ‹Floyd-Warshall and Empty DBMs›
theorem FW_detects_empty_zone:
"∀k≤n. 0 < k ⟶ (∃c. v c = k) ⟹ ∀ c. v c ≤ n ⟶ v c > 0
⟹ [FW M n]⇘v,n⇙ = {} ⟷ (∃ i≤n. (FW M n) i i < Le 0)"
proof
assume surj_on:"∀k≤n. 0 < k ⟶ (∃c. v c = k)" and "∃i≤n. (FW M n) i i < Le 0"
then obtain i where *: "len (FW M n) i i [] < 𝟭" "i ≤n" by (auto simp add: neutral)
show "[FW M n]⇘v,n⇙ = {}"
proof (rule ccontr, goal_cases)
case 1
then obtain u where "DBM_val_bounded v u (FW M n) n" unfolding DBM_zone_repr_def by auto
from DBM_val_bounded_neg_cycle[OF this *(2) _ *(1) surj_on] show ?case by auto
qed
next
assume surj_on: "∀k≤n. 0 < k ⟶ (∃c. v c = k)" and empty: "[FW M n]⇘v,n⇙ = {}"
and cn: "∀ c. v c ≤ n ⟶ v c > 0"
show "∃ i≤n. (FW M n) i i < Le 0"
proof (rule ccontr, goal_cases)
case 1
then have *:"∀i≤n. FW M n i i ≥ 𝟭" by (auto simp add: neutral)
have "cyc_free M n"
proof (rule ccontr)
assume "¬ cyc_free M n"
then have A: "¬ cycle_free M n" using cycle_free_diag_equiv by auto
from FW_neg_cycle_detect[OF A] * show False by auto
qed
from FW_cyc_free_preservation[OF this] have "cyc_free (FW M n) n" .
from cyc_free_obtains_valuation[OF ‹cyc_free (FW M n) n› cn] empty
obtain u where "DBM_val_bounded v u (FW M n) n" by blast
with empty show ?case by (auto simp add: DBM_zone_repr_def)
qed
qed
hide_const D
subsection ‹Mixed Corollaries›
lemma cyc_free_not_empty:
assumes "cyc_free M n" "∀c. v c ≤ n ⟶ 0 < v c"
shows "[(M :: ('a :: time) DBM)]⇘v,n⇙ ≠ {}"
using cyc_free_obtains_valuation[OF assms(1,2)] unfolding DBM_zone_repr_def by auto
lemma empty_not_cyc_free:
assumes "∀c. v c ≤ n ⟶ 0 < v c" "[(M :: ('a :: time) DBM)]⇘v,n⇙ = {}"
shows "¬ cyc_free M n"
using assms by (meson cyc_free_not_empty)
lemma not_empty_cyc_free:
assumes "∀k≤n. 0 < k ⟶ (∃ c. v c = k)" "[(M :: ('a :: time) DBM)]⇘v,n⇙ ≠ {}"
shows "cyc_free M n" using DBM_val_bounded_neg_cycle[OF _ _ _ _ assms(1)] assms(2)
unfolding DBM_zone_repr_def by fastforce
lemma neg_cycle_empty:
assumes "∀k≤n. 0 < k ⟶ (∃ c. v c = k)" "set xs ⊆ {0..n}" "i ≤ n" "len M i i xs < 𝟭"
shows "[(M :: ('a :: time) DBM)]⇘v,n⇙ = {}" using assms
by (metis leD not_empty_cyc_free)
abbreviation clock_numbering' :: "('c ⇒ nat) ⇒ nat ⇒ bool"
where
"clock_numbering' v n ≡ ∀ c. v c > 0 ∧ (∀x. ∀y. v x ≤ n ∧ v y ≤ n ∧ v x = v y ⟶ x = y)"
lemma non_empty_dbm_diag_set:
"clock_numbering' v n ⟹ [M]⇘v,n⇙ ≠ {} ⟹ [M]⇘v,n⇙ = [(λ i j. if i = j then 𝟭 else M i j)]⇘v,n⇙"
proof (auto simp: DBM_zone_repr_def, goal_cases)
case 1
{ fix c assume A: "v c = 0"
from 1 have "v c > 0" by auto
with A have False by auto
} note * = this
from 1(1) have [simp]: "Le 0 ≼ M 0 0" by (auto simp: DBM_val_bounded_def)
from 1 show ?case
apply (auto simp add: DBM_val_bounded_def neutral)
using * apply meson+
apply (rename_tac c1 c2)
apply (case_tac "c1 = c2")
apply auto
done
next
case (2 x xa)
note G = this
{ fix c assume A: "v c = 0"
from 2 have "v c > 0" by auto
with A have False by auto
} note * = this
{ fix c assume A: "v c ≤ n" "M (v c) (v c) < 𝟭"
with 2(1) have False
apply (auto simp: neutral DBM_val_bounded_def less)
apply (cases rule: dbm_lt.cases)
by fastforce+
} note ** = this
from 2(1) have [simp]: "Le 0 ≼ M 0 0" by (auto simp: DBM_val_bounded_def)
from 2 show ?case
proof (auto simp add: DBM_val_bounded_def neutral, goal_cases)
case 1 with * show ?case by presburger
case 2 with * show ?case by presburger
next
case (3 c1 c2)
show ?case
proof (cases "v c1 = v c2")
case True
with 3 have "c1 = c2" by auto
moreover with **[OF 3(8)] not_less have "M (v c2) (v c2) ≥ 𝟭" by auto
ultimately show "dbm_entry_val xa (Some c1) (Some c2) (M (v c1) (v c2))" unfolding neutral
by (cases "M (v c1) (v c2)") (auto simp add: less_eq dbm_le_def, fastforce+)
next
case False
with 3 show ?thesis by presburger
qed
qed
qed
lemma non_empty_cycle_free:
assumes "[M]⇘v,n⇙ ≠ {}"
and "∀k≤n. 0 < k ⟶ (∃c. v c = k)"
shows "cycle_free M n"
apply (rule ccontr)
apply (drule negative_cycle_dest_diag)
using DBM_val_bounded_neg_cycle assms unfolding DBM_zone_repr_def by blast
lemma neg_diag_empty:
assumes "∀k≤n. 0 < k ⟶ (∃c. v c = k)" "i ≤ n" "M i i < 𝟭"
shows "[M]⇘v,n⇙ = {}"
unfolding DBM_zone_repr_def using DBM_val_bounded_neg_cycle[of v _ M n i "[]"] assms by auto
lemma canonical_empty_zone:
assumes "∀k≤n. 0 < k ⟶ (∃c. v c = k)" "∀c. v c ≤ n ⟶ 0 < v c"
and "canonical M n"
shows "[M]⇘v,n⇙ = {} ⟷ (∃i≤n. M i i < 𝟭)"
using FW_detects_empty_zone[OF assms(1,2), of M] FW_canonical_id[OF assms(3)] unfolding neutral
by simp
end
Theory DBM_Operations
chapter ‹Forward Analysis on DBMs›
theory DBM_Operations
imports DBM_Basics
begin
section ‹Auxiliary›
lemma gt_swap:
fixes a b c :: "'t :: time"
assumes "c < a + b"
shows "c < b + a"
by (simp add: add.commute assms)
lemma le_swap:
fixes a b c :: "'t :: time"
assumes "c ≤ a + b"
shows "c ≤ b + a"
by (simp add: add.commute assms)
abbreviation clock_numbering :: "('c ⇒ nat) ⇒ bool"
where
"clock_numbering v ≡ ∀ c. v c > 0"
section ‹Time Lapse›
definition up :: "('t::time) DBM ⇒ ('t::time) DBM"
where
"up M ≡
λ i j. if i > 0 then if j = 0 then ∞ else min (dbm_add (M i 0) (M 0 j)) (M i j) else M i j"
lemma dbm_entry_dbm_lt:
assumes "dbm_entry_val u (Some c1) (Some c2) a" "a ≺ b"
shows "dbm_entry_val u (Some c1) (Some c2) b"
using assms
proof (cases, auto, goal_cases)
case 1 thus ?case by (cases, auto)
next
case 2 thus ?case by (cases, auto)
qed
lemma dbm_entry_dbm_min2:
assumes "dbm_entry_val u None (Some c) (min a b)"
shows "dbm_entry_val u None (Some c) b"
using dbm_entry_val_mono_2[folded less_eq, OF assms] by auto
lemma dbm_entry_dbm_min3:
assumes "dbm_entry_val u (Some c) None (min a b)"
shows "dbm_entry_val u (Some c) None b"
using dbm_entry_val_mono_3[folded less_eq, OF assms] by auto
lemma dbm_entry_dbm_min:
assumes "dbm_entry_val u (Some c1) (Some c2) (min a b)"
shows "dbm_entry_val u (Some c1) (Some c2) b"
using dbm_entry_val_mono_1[folded less_eq, OF assms] by auto
lemma dbm_entry_dbm_min3':
assumes "dbm_entry_val u (Some c) None (min a b)"
shows "dbm_entry_val u (Some c) None a"
using dbm_entry_val_mono_3[folded less_eq, OF assms] by auto
lemma dbm_entry_dbm_min2':
assumes "dbm_entry_val u None (Some c) (min a b)"
shows "dbm_entry_val u None (Some c) a"
using dbm_entry_val_mono_2[folded less_eq, OF assms] by auto
lemma dbm_entry_dbm_min':
assumes "dbm_entry_val u (Some c1) (Some c2) (min a b)"
shows "dbm_entry_val u (Some c1) (Some c2) a"
using dbm_entry_val_mono_1[folded less_eq, OF assms] by auto
lemma DBM_up_complete': "clock_numbering v ⟹ u ∈ ([M]⇘v,n⇙)⇧↑ ⟹ u ∈ [up M]⇘v,n⇙"
unfolding up_def DBM_zone_repr_def DBM_val_bounded_def zone_delay_def
proof (safe, goal_cases)
case prems: (2 u d c)
hence *: "dbm_entry_val u None (Some c) (M 0 (v c))" by auto
thus ?case
proof (cases, goal_cases)
case (1 d')
have "- (u c + d) ≤ - u c" using ‹d ≥ 0› by simp
with 1(2) have "- (u c + d)≤ d'" by (blast intro: order.trans)
thus ?case unfolding cval_add_def using 1 by fastforce
next
case (2 d')
have "- (u c + d) ≤ - u c" using ‹d ≥ 0› by simp
with 2(2) have "- (u c + d) < d'" by (blast intro: order_le_less_trans)
thus ?case unfolding cval_add_def using 2 by fastforce
qed auto
next
case prems: (4 u d c1 c2)
then have
"dbm_entry_val u (Some c1) None (M (v c1) 0)" "dbm_entry_val u None (Some c2) (M 0 (v c2))"
by auto
from dbm_entry_val_add_4[OF this] prems have
"dbm_entry_val u (Some c1) (Some c2) (min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2)))"
by (auto split: split_min)
with prems(1) show ?case
by (cases "min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2))", auto simp: cval_add_def)
qed auto
fun theLe :: "('t::time) DBMEntry ⇒ 't" where
"theLe (Le d) = d" |
"theLe (Lt d) = d" |
"theLe ∞ = 0"
lemma DBM_up_sound':
assumes "clock_numbering' v n" "u ∈ [up M]⇘v,n⇙"
shows "u ∈ ([M]⇘v,n⇙)⇧↑"
unfolding DBM_zone_repr_def zone_delay_def using assms
proof (clarsimp, goal_cases)
case A: 1
obtain S_Max_Le where S_Max_Le:
"S_Max_Le = {d - u c | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Le d}"
by auto
obtain S_Max_Lt where S_Max_Lt:
"S_Max_Lt = {d - u c | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Lt d}"
by auto
obtain S_Min_Le where S_Min_Le:
"S_Min_Le = {- d - u c| c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Le d}"
by auto
obtain S_Min_Lt where S_Min_Lt:
"S_Min_Lt = {- d - u c | c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Lt d}"
by auto
have "finite {c. 0 < v c ∧ v c ≤ n}"
using A(2,3)
proof (induction n)
case 0
then have "{c. 0 < v c ∧ v c ≤ 0} = {}" by auto
then show ?case by (metis finite.emptyI)
next
case (Suc n)
then have "finite {c. 0 < v c ∧ v c ≤ n}" by auto
moreover have "{c. 0 < v c ∧ v c ≤ Suc n} = {c. 0 < v c ∧ v c ≤ n} ∪ {c. v c = Suc n}" by auto
moreover have "finite {c. v c = Suc n}"
proof (cases "{c. v c = Suc n} = {}", auto)
fix c assume "v c = Suc n"
then have "{c. v c = Suc n} = {c}" using Suc.prems(2) by auto
then show ?thesis by auto
qed
ultimately show ?case by auto
qed
then have "∀ f. finite {(c,b) | c b. 0 < v c ∧ v c ≤ n ∧ f M (v c) = b}" by auto
moreover have
"∀ f K. {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}
⊆ {(c,b) | c b. 0 < v c ∧ v c ≤ n ∧ f M (v c) = b}"
by auto
ultimately have 1:
"∀ f K. finite {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}" using finite_subset
by fast
have "∀ f K. theLe o K = id ⟶ finite {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}"
proof (safe, goal_cases)
case prems: (1 f K)
then have
"{(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}
= (λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}"
proof (auto simp add: pointfree_idE, goal_cases)
case (1 a b)
then have "(a, K b) ∈ {(c, K d) |c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}" by auto
moreover from 1(1) have "theLe (K b) = b" by (simp add: pointfree_idE)
ultimately show ?case by force
qed
moreover from 1 have
"finite ((λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d})"
by auto
ultimately show ?case by auto
qed
then have finI:
"⋀ f g K. theLe o K = id ⟹ finite (g ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d})"
by auto
have
"finite ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Le d})"
by (rule finI, auto)
moreover have
"S_Min_Le = ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Le d})"
using S_Min_Le by auto
ultimately have fin_min_le: "finite S_Min_Le" by auto
have
"finite ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Lt d})"
by (rule finI, auto)
moreover have
"S_Min_Lt = ((λ(c,d). - d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M 0 (v c) = Lt d})"
using S_Min_Lt by auto
ultimately have fin_min_lt: "finite S_Min_Lt" by auto
have "finite ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Le d})"
by (rule finI, auto)
moreover have
"S_Max_Le = ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Le d})"
using S_Max_Le by auto
ultimately have fin_max_le: "finite S_Max_Le" by auto
have
"finite ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Lt d})"
by (rule finI, auto)
moreover have
"S_Max_Lt = ((λ(c,d). d - u c) ` {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ M (v c) 0 = Lt d})"
using S_Max_Lt by auto
ultimately have fin_max_lt: "finite S_Max_Lt" by auto
{ fix x assume "x ∈ S_Min_Le"
hence "x ≤ 0" unfolding S_Min_Le
proof (safe, goal_cases)
case (1 c d)
with A(1) have "- u c ≤ d" unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
thus ?case by (simp add: minus_le_iff)
qed
} note Min_Le_le_0 = this
have Min_Lt_le_0: "x < 0" if "x ∈ S_Min_Lt" for x using that unfolding S_Min_Lt
proof (safe, goal_cases)
case (1 c d)
with A(1) have "- u c < d" unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
thus ?case by (simp add: minus_less_iff)
qed
text ‹
The following basically all use the same proof.
Only the first is not completely identical but nearly identical.
›
{ fix l r assume "l ∈ S_Min_Le" "r ∈ S_Max_Le"
with S_Min_Le S_Max_Le have "l ≤ r"
proof (safe, goal_cases)
case (1 c c' d d')
note G1 = this
hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
using A unfolding up_def by (auto split: split_min)
have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
using dbm_entry_dbm_min' * by auto
hence "u c' - u c ≤ d' + d" using G1 by auto
hence "u c' + (- u c - d) ≤ d'" by (simp add: add_diff_eq diff_le_eq)
hence "- u c - d ≤ d' - u c'" by (simp add: add.commute le_diff_eq)
thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
qed
} note EE = this
{ fix l r assume "l ∈ S_Min_Le" "r ∈ S_Max_Le"
with S_Min_Le S_Max_Le have "l ≤ r"
proof (auto, goal_cases)
case (1 c c' d d')
note G1 = this
hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
using A unfolding up_def by (auto split: split_min)
have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
using dbm_entry_dbm_min' * by auto
hence "u c' - u c ≤ d' + d" using G1 by auto
hence "u c' + (- u c - d) ≤ d'" by (simp add: add_diff_eq diff_le_eq)
hence "- u c - d ≤ d' - u c'" by (simp add: add.commute le_diff_eq)
thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
qed
} note EE = this
{ fix l r assume "l ∈ S_Min_Lt" "r ∈ S_Max_Le"
with S_Min_Lt S_Max_Le have "l < r"
proof (auto, goal_cases)
case (1 c c' d d')
note G1 = this
hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
using A unfolding up_def by (auto split: split_min)
have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
using dbm_entry_dbm_min' * by auto
hence "u c' - u c < d' + d" using G1 by auto
hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq)
thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
qed
} note LE = this
{ fix l r assume "l ∈ S_Min_Le" "r ∈ S_Max_Lt"
with S_Min_Le S_Max_Lt have "l < r"
proof (auto, goal_cases)
case (1 c c' d d')
note G1 = this
hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
using A unfolding up_def by (auto split: split_min)
have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
using dbm_entry_dbm_min' * by auto
hence "u c' - u c < d' + d" using G1 by auto
hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq)
thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
qed
} note EL = this
{ fix l r assume "l ∈ S_Min_Lt" "r ∈ S_Max_Lt"
with S_Min_Lt S_Max_Lt have "l < r"
proof (auto, goal_cases)
case (1 c c' d d')
note G1 = this
hence *:"(up M) (v c') (v c) = min (dbm_add (M (v c') 0) (M 0 (v c))) (M (v c') (v c))"
using A unfolding up_def by (auto split: split_min)
have "dbm_entry_val u (Some c') (Some c) ((up M) (v c') (v c))"
using A G1 unfolding DBM_zone_repr_def DBM_val_bounded_def by fastforce
hence "dbm_entry_val u (Some c') (Some c) (dbm_add (M (v c') 0) (M 0 (v c)))"
using dbm_entry_dbm_min' * by auto
hence "u c' - u c < d' + d" using G1 by auto
hence "u c' + (- u c - d) < d'" by (simp add: add_diff_eq diff_less_eq)
hence "- u c - d < d' - u c'" by (simp add: add.commute less_diff_eq)
thus ?case by (metis add_uminus_conv_diff uminus_add_conv_diff)
qed
} note LL = this
obtain m where m: "∀ t ∈ S_Min_Le. m ≥ t" "∀ t ∈ S_Min_Lt. m > t"
"∀ t ∈ S_Max_Le. m ≤ t" "∀ t ∈ S_Max_Lt. m < t" "m ≤ 0"
proof -
assume m:"(⋀m. ∀t∈S_Min_Le. t ≤ m ⟹
∀t∈S_Min_Lt. t < m ⟹ ∀t∈S_Max_Le. m ≤ t ⟹ ∀t∈S_Max_Lt. m < t ⟹ m ≤ 0 ⟹ thesis)"
let ?min_le = "Max S_Min_Le"
let ?min_lt = "Max S_Min_Lt"
let ?max_le = "Min S_Max_Le"
let ?max_lt = "Min S_Max_Lt"
show thesis
proof (cases "S_Min_Le = {} ∧ S_Min_Lt = {}")
case True
note T = this
show thesis
proof (cases "S_Max_Le = {} ∧ S_Max_Lt = {}")
case True
let ?d' = "0 :: 't :: time"
show thesis using True T by (intro m[of ?d']) auto
next
case False
let ?d =
"if S_Max_Le ≠ {}
then if S_Max_Lt ≠ {} then min ?max_lt ?max_le else ?max_le
else ?max_lt"
obtain a :: "'b" where a: "a < 0" using non_trivial_neg by auto
let ?d' = "min 0 (?d + a)"
{ fix x assume "x ∈ S_Max_Le"
with fin_max_le a have "min 0 (Min S_Max_Le + a) ≤ x"
by (metis Min_le add_le_same_cancel1 le_less_trans less_imp_le min.cobounded2 not_less)
then have "min 0 (Min S_Max_Le + a) ≤ x" by auto
} note 1 = this
{ fix x assume x: "x ∈ S_Max_Lt"
have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < ?max_lt"
by (meson a add_less_same_cancel1 min.cobounded1 min.strict_coboundedI2 order.strict_trans2)
also from fin_max_lt x have "… ≤ x" by auto
finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < x" .
} note 2 = this
{ fix x assume x: "x ∈ S_Max_Le"
have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) ≤ ?max_le"
by (metis le_add_same_cancel1 linear not_le a min_le_iff_disj)
also from fin_max_le x have "… ≤ x" by auto
finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) ≤ x" .
} note 3 = this
show thesis using False T a 1 2 3
proof ((intro m[of ?d']), auto, goal_cases)
case 1 then show ?case
by (metis Min.coboundedI add_less_same_cancel1 dual_order.strict_trans2 fin_max_lt
min.boundedE not_le)
qed
qed
next
case False
note F = this
show thesis
proof (cases "S_Max_Le = {} ∧ S_Max_Lt = {}")
case True
let ?d' = "0 :: 't :: time"
show thesis using True Min_Le_le_0 Min_Lt_le_0 by (intro m[of ?d']) auto
next
case False
let ?r =
"if S_Max_Le ≠ {}
then if S_Max_Lt ≠ {} then min ?max_lt ?max_le else ?max_le
else ?max_lt"
let ?l =
"if S_Min_Le ≠ {}
then if S_Min_Lt ≠ {} then max ?min_lt ?min_le else ?min_le
else ?min_lt"
have 1: "x ≤ max ?min_lt ?min_le" "x ≤ ?min_le" if "x ∈ S_Min_Le" for x
using that fin_min_le by (simp add: max.coboundedI2)+
{
fix x y assume x: "x ∈ S_Max_Le" "y ∈ S_Min_Lt"
then have "S_Min_Lt ≠ {}" by auto
from LE[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt ≤ x" by auto
} note 3 = this
have 4: "?min_le ≤ x" if "x ∈ S_Max_Le" "y ∈ S_Min_Le" for x y
using EE[OF Max_in[OF fin_min_le], OF _ that(1)] that by auto
{
fix x y assume x: "x ∈ S_Max_Lt" "y ∈ S_Min_Lt"
then have "S_Min_Lt ≠ {}" by auto
from LL[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt < x" by auto
} note 5 = this
{
fix x y assume x: "x ∈ S_Max_Lt" "y ∈ S_Min_Le"
then have "S_Min_Le ≠ {}" by auto
from EL[OF Max_in[OF fin_min_le], OF this, OF x(1)] have "?min_le < x" by auto
} note 6 = this
{
fix x y assume x: "y ∈ S_Min_Le"
then have "S_Min_Le ≠ {}" by auto
from Min_Le_le_0[OF Max_in[OF fin_min_le], OF this] have "?min_le ≤ 0" by auto
} note 7 = this
{
fix x y assume x: "y ∈ S_Min_Lt"
then have "S_Min_Lt ≠ {}" by auto
from Min_Lt_le_0[OF Max_in[OF fin_min_lt], OF this] have "?min_lt < 0" "?min_lt ≤ 0" by auto
} note 8 = this
show thesis
proof (cases "?l < ?r")
case False
then have *: "S_Max_Le ≠ {}"
proof (auto, goal_cases)
case 1
with ‹¬ (S_Max_Le = {} ∧ S_Max_Lt = {})› obtain y where y:"y ∈ S_Max_Lt" by auto
note 1 = 1 this
{ fix x y assume A: "x ∈ S_Min_Le" "y ∈ S_Max_Lt"
with EL[OF Max_in[OF fin_min_le] Min_in[OF fin_max_lt]]
have "Max S_Min_Le < Min S_Max_Lt" by auto
} note ** = this
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Lt"
with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
have "Max S_Min_Lt < Min S_Max_Lt" by auto
} note *** = this
show ?case
proof (cases "S_Min_Le ≠ {}")
case True
note T = this
show ?thesis
proof (cases "S_Min_Lt ≠ {}")
case True
then show False using 1 T True ** *** by auto
next
case False with 1 T ** show False by auto
qed
next
case False
with 1 False *** ‹¬ (S_Min_Le = {} ∧ S_Min_Lt = {})› show ?thesis by auto
qed
qed
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Lt"
with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
have "Max S_Min_Lt < Min S_Max_Lt" by auto
} note *** = this
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Le"
with LE[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_le]]
have "Max S_Min_Lt < Min S_Max_Le" by auto
} note **** = this
from F False have **: "S_Min_Le ≠ {}"
proof (auto, goal_cases)
case 1
show ?case
proof (cases "S_Max_Le ≠ {}")
case True
note T = this
show ?thesis
proof (cases "S_Max_Lt ≠ {}")
case True
then show False using 1 T True **** *** by auto
next
case False with 1 T **** show False by auto
qed
next
case False
with 1 False *** ‹¬ (S_Max_Le = {} ∧ S_Max_Lt = {})› show ?thesis by auto
qed
qed
{
fix x assume x: "x ∈ S_Min_Lt"
then have "x ≤ ?min_lt" using fin_min_lt by (simp add: max.coboundedI2)
also have "?min_lt < ?min_le"
proof (rule ccontr, goal_cases)
case 1
with x ** have 1: "?l = ?min_lt" by (auto simp: max.absorb1)
have 2: "?min_lt < ?max_le" using * ****[OF x] by auto
show False
proof (cases "S_Max_Lt = {}")
case False
then have "?min_lt < ?max_lt" using * ***[OF x] by auto
with 1 2 have "?l < ?r" by auto
with ‹¬ ?l < ?r› show False by auto
next
case True
with 1 2 have "?l < ?r" by auto
with ‹¬ ?l < ?r› show False by auto
qed
qed
finally have "x < max ?min_lt ?min_le" by (simp add: max.strict_coboundedI2)
} note 2 = this
show thesis using F False 1 2 3 4 5 6 7 8 * ** by ((intro m[of ?l]), auto)
next
case True
then obtain d where d: "?l < d" "d < ?r" using dense by auto
let ?d' = "min 0 d"
{
fix t assume "t ∈ S_Min_Le"
then have "t ≤ ?l" using 1 by auto
with d have "t ≤ d" by auto
}
moreover {
fix t assume t: "t ∈ S_Min_Lt"
then have "t ≤ max ?min_lt ?min_le" using fin_min_lt by (simp add: max.coboundedI1)
with t Min_Lt_le_0 have "t ≤ ?l" using fin_min_lt by auto
with d have "t < d" by auto
}
moreover {
fix t assume t: "t ∈ S_Max_Le"
then have "min ?max_lt ?max_le ≤ t" using fin_max_le by (simp add: min.coboundedI2)
then have "?r ≤ t" using fin_max_le t by auto
with d have "d ≤ t" by auto
then have "min 0 d ≤ t" by (simp add: min.coboundedI2)
}
moreover {
fix t assume t: "t ∈ S_Max_Lt"
then have "min ?max_lt ?max_le ≤ t" using fin_max_lt by (simp add: min.coboundedI1)
then have "?r ≤ t" using fin_max_lt t by auto
with d have "d < t" by auto
then have "min 0 d < t" by (simp add: min.strict_coboundedI2)
}
ultimately show thesis using Min_Le_le_0 Min_Lt_le_0 by ((intro m[of ?d']), auto)
qed
qed
qed
qed
obtain u' where "u' = (u ⊕ m)" by blast
hence u': "u = (u' ⊕ (-m))" unfolding cval_add_def by force
have "DBM_val_bounded v u' M n" unfolding DBM_val_bounded_def
proof (auto, goal_cases)
case 1 with A(1,2) show ?case unfolding DBM_zone_repr_def DBM_val_bounded_def up_def by auto
next
case (3 c)
thus ?case
proof (cases "M (v c) 0", goal_cases)
case (1 x1)
hence "m ≤ x1 - u c" using m(3) S_Max_Le A(2) by blast
hence "u c + m ≤ x1" by (simp add: add.commute le_diff_eq)
thus ?case using u' 1(2) unfolding cval_add_def by auto
next
case (2 x2)
hence "m < x2 - u c" using m(4) S_Max_Lt A(2) by blast
hence "u c + m < x2" by (metis add_less_cancel_left diff_add_cancel gt_swap)
thus ?case using u' 2(2) unfolding cval_add_def by auto
next
case 3 thus ?case by auto
qed
next
case (2 c) thus ?case
proof (cases "M 0 (v c)", goal_cases)
case (1 x1)
hence "- x1 - u c ≤ m" using m(1) S_Min_Le A(2) by blast
hence "- u c - m ≤ x1" using diff_le_eq neg_le_iff_le by fastforce
thus ?case using u' 1(2) unfolding cval_add_def by auto
next
case (2 x2)
hence "- x2 - u c < m" using m(2) S_Min_Lt A(2) by blast
hence "- u c - m < x2" using diff_less_eq neg_less_iff_less by fastforce
thus ?case using u' 2(2) unfolding cval_add_def by auto
next
case 3 thus ?case by auto
qed
next
case (4 c1 c2)
from A(2) have "v c1 > 0" "v c2 ≠ 0" by auto
then have B: "(up M) (v c1) (v c2) = min (dbm_add (M (v c1) 0) (M 0 (v c2))) (M (v c1) (v c2))"
unfolding up_def by simp
show ?case
proof (cases "(dbm_add (M (v c1) 0) (M 0 (v c2))) < (M (v c1) (v c2))")
case False
with B have "(up M) (v c1) (v c2) = M (v c1) (v c2)" by (auto split: split_min)
with A(1) 4 have
"dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
unfolding DBM_zone_repr_def unfolding DBM_val_bounded_def by fastforce
thus ?thesis using u' by cases (auto simp add: cval_add_def)
next
case True
with B have "(up M) (v c1) (v c2) = dbm_add (M (v c1) 0) (M 0 (v c2))" by (auto split: split_min)
with A(1) 4 have
"dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) 0) (M 0 (v c2)))"
unfolding DBM_zone_repr_def unfolding DBM_val_bounded_def by fastforce
with True dbm_entry_dbm_lt have
"dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
unfolding less by fast
thus ?thesis using u' by cases (auto simp add: cval_add_def)
qed
qed
with m(5) u' show ?case by fastforce
qed
section ‹From Clock Constraints to DBMs›
fun And :: "('t :: time) DBM ⇒ 't DBM ⇒ 't DBM" where
"And M1 M2 = (λ i j. min (M1 i j) (M2 i j))"
fun abstr :: "('c, 't::time) cconstraint ⇒ 't DBM ⇒ ('c ⇒ nat) ⇒ 't DBM"
where
"abstr (AND cc1 cc2) M v = And (abstr cc1 M v) (abstr cc2 M v)" |
"abstr (EQ c d) M v =
(λ i j . if i = 0 ∧ j = v c then Le (-d) else if i = v c ∧ j = 0 then Le d else M i j)" |
"abstr (LT c d) M v =
(λ i j . if i = 0 ∧ j = v c then ∞ else if i = v c ∧ j = 0 then Lt d else M i j)" |
"abstr (LE c d) M v =
(λ i j . if i = 0 ∧ j = v c then ∞ else if i = v c ∧ j = 0 then Le d else M i j)" |
"abstr (GT c d) M v =
(λ i j. if i = 0 ∧ j = v c then Lt (- d) else if i = v c ∧ j = 0 then ∞ else M i j)" |
"abstr (GE c d) M v =
(λ i j. if i = 0 ∧ j = v c then Le (- d) else if i = v c ∧ j = 0 then ∞ else M i j)"
lemma abstr_id1:
"c ∉ collect_clks cc ⟹ clock_numbering' v n ⟹ ∀ c ∈ collect_clks cc. v c ≤ n
⟹ abstr cc M v 0 (v c) = M 0 (v c)"
by (induction cc) auto
lemma abstr_id2:
"c ∉ collect_clks cc ⟹ clock_numbering' v n ⟹ ∀ c ∈ collect_clks cc. v c ≤ n
⟹ abstr cc M v (v c) 0 = M (v c) 0"
by (induction cc) auto
text ‹
This lemma is trivial because we constrained our theory to difference constraints.
›
lemma abstr_id3:
"clock_numbering v ⟹ abstr cc M v (v c1) (v c2) = M (v c1) (v c2)"
proof goal_cases
case 1
have "⋀c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from 1 have "v c > 0" by auto
ultimately show False by linarith
qed
then show ?case by ((induction cc), auto, fastforce)
qed
lemma dbm_abstr_soundness :
"⟦u ⊢ cc; clock_numbering' v n; ∀ c ∈ collect_clks cc. v c ≤ n⟧
⟹ DBM_val_bounded v u (abstr cc (λ i j. ∞) v) n"
proof (unfold DBM_val_bounded_def, auto, goal_cases)
case 1
from this(3) have "abstr cc (λi j. ∞) v 0 0 = ∞" by (induction cc) auto
then show ?case unfolding dbm_le_def by auto
next
case (2 c)
then have "clock_numbering' v n" by auto
note A = 2(1) this 2(5,2)
show ?case
proof (cases "c ∈ collect_clks cc")
case True
then show ?thesis using A(1,4)
proof (induction rule: collect_clks.induct)
case (1 cc1 cc2)
{ assume cc: "c ∈ collect_clks cc1" "c ∈ collect_clks cc2"
with 1 have ?case by auto linarith
} note both = this
show ?case
proof (cases "c ∈ collect_clks cc1")
case True
note cc1 = this
with 1 have *: "dbm_entry_val u None (Some c) (abstr cc1 (λi j. ∞) v 0 (v c))" by auto
show ?thesis
proof (cases "c ∈ collect_clks cc2")
case True with cc1 both show ?thesis by auto
next
case False
from abstr_id1[OF False A(2)] 1(5)
have
"min (abstr cc1 (λi j. ∞) v 0 (v c)) (abstr cc2 (λi j. ∞) v 0 (v c))
= abstr cc1 (λi j. ∞) v 0 (v c)"
by (simp add: any_le_inf min.absorb1)
with * show ?thesis by auto
qed
next
case False
note cc1 = this
show ?thesis
proof (cases "c ∈ collect_clks cc2")
case True
with 1 have *: "dbm_entry_val u None (Some c) (abstr cc2 (λi j. ∞) v 0 (v c))" by auto
from abstr_id1[OF cc1 A(2)] 1(5)
have
"min (abstr cc1 (λi j. ∞) v 0 (v c)) (abstr cc2 (λi j. ∞) v 0 (v c))
= abstr cc2 (λi j. ∞) v 0 (v c)"
by (simp add: any_le_inf min.absorb2)
with * show ?thesis by auto
next
case False
with 1 cc1 show ?thesis by auto
qed
qed
qed auto
next
case False
from abstr_id1[OF this A(2,4)] show ?thesis by auto
qed
next
case (3 c)
then have "clock_numbering' v n" by auto
note A = 3(1) this 3(5,2)
from A(2) have gt0: "v c > 0" by auto
show ?case
proof (cases "c ∈ collect_clks cc")
case True
then show ?thesis using A(1,4)
proof (induction rule: collect_clks.induct)
case (1 cc1 cc2)
{ assume cc: "c ∈ collect_clks cc1" "c ∈ collect_clks cc2"
with 1 have ?case by auto linarith
} note both = this
show ?case
proof (cases "c ∈ collect_clks cc1")
case True
note cc1 = this
with 1 have *: "dbm_entry_val u (Some c) None (abstr cc1 (λi j. ∞) v (v c) 0)" by auto
show ?thesis
proof (cases "c ∈ collect_clks cc2")
case True with cc1 both show ?thesis by auto
next
case False
from abstr_id2[OF False A(2)] 1(5)
have
"min (abstr cc1 (λi j. ∞) v (v c) 0) (abstr cc2 (λi j. ∞) v (v c) 0)
= abstr cc1 (λi j. ∞) v (v c) 0"
by (simp add: any_le_inf min.absorb1)
with * show ?thesis by auto
qed
next
case False
note cc1 = this
show ?thesis
proof (cases "c ∈ collect_clks cc2")
case True
with 1 have *: "dbm_entry_val u (Some c) None (abstr cc2 (λi j. ∞) v (v c) 0)"
by auto
from abstr_id2[OF cc1 A(2)] 1(5)
have
"min (abstr cc1 (λi j. ∞) v (v c) 0) (abstr cc2 (λi j. ∞) v (v c) 0)
= abstr cc2 (λi j. ∞) v (v c) 0"
by (simp add: any_le_inf min.absorb2)
with * show ?thesis by auto
next
case False
with 1 cc1 show ?thesis by auto
qed
qed
qed (insert gt0, auto)
next
case False
from abstr_id2[OF this A(2,4)] show ?thesis by auto
qed
next
text ‹Trivial because of missing difference constraints›
case (4 c1 c2)
from abstr_id3[OF this(3)] have "abstr cc (λi j. ∞) v (v c1) (v c2) = ∞" by auto
then show ?case by auto
qed
lemma dbm_abstr_completeness:
"⟦DBM_val_bounded v u (abstr cc (λ i j. ∞) v) n; ∀c. v c > 0; ∀ c ∈ collect_clks cc. v c ≤ n⟧
⟹ u ⊢ cc"
proof (induction cc, goal_cases)
case (1 cc1 cc2)
then have AND: "u ∈ [abstr (AND cc1 cc2) (λi j. ∞) v]⇘v,n⇙" by (simp add: DBM_zone_repr_def)
from 1 have "∀i j. i ≤ n ⟶ j ≤ n
⟶ (abstr (AND cc1 cc2) (λi j. ∞) v) i j ≼ (abstr cc1 (λi j. ∞) v) i j"
by (simp add: less_eq[symmetric])
from DBM_le_subset[OF this AND] 1 have "u ⊢ cc1" unfolding DBM_zone_repr_def by auto
from 1 have "∀i j. i ≤ n ⟶ j ≤ n
⟶ (abstr (AND cc1 cc2) (λi j. ∞) v) i j ≼ (abstr cc2 (λi j. ∞) v) i j"
by (simp add: less_eq[symmetric])
from DBM_le_subset[OF this AND] 1 have "u ⊢ cc2" unfolding DBM_zone_repr_def by auto
from ‹u ⊢ cc1› ‹u ⊢ cc2› show ?case by auto
next
case (2 c d)
from this have "v c ≤ n" by auto
with 2(1) have "dbm_entry_val u (Some c) None ((abstr (LT c d) (λi j. ∞) v) (v c) 0)"
by (auto simp: DBM_val_bounded_def)
moreover from 2(2) have "v c > 0" by auto
ultimately show ?case by auto
next
case (3 c d)
from this have "v c ≤ n" by auto
with 3(1) have "dbm_entry_val u (Some c) None ((abstr (LE c d) (λi j. ∞) v) (v c) 0)"
by (auto simp: DBM_val_bounded_def)
moreover from 3(2) have "v c > 0" by auto
ultimately show ?case by auto
next
case (4 c d)
from this have c: "v c > 0" "v c ≤ n" by auto
with 4(1) have B:
"dbm_entry_val u (Some c) None ((abstr (EQ c d) (λi j. ∞) v) (v c) 0)"
"dbm_entry_val u None (Some c) ((abstr (EQ c d) (λi j. ∞) v) 0 (v c))"
by (auto simp: DBM_val_bounded_def)
from c B have "u c ≤ d" "- u c ≤ -d" by auto
then show ?case by auto
next
case (5 c d)
from this have "v c ≤ n" by auto
with 5(1) have "dbm_entry_val u None (Some c) ((abstr (GT c d) (λi j. ∞) v) 0 (v c))"
by (auto simp: DBM_val_bounded_def)
moreover from 5(2) have "v c > 0" by auto
ultimately show ?case by auto
next
case (6 c d)
from this have "v c ≤ n" by auto
with 6(1) have "dbm_entry_val u None (Some c) ((abstr (GE c d) (λi j. ∞) v) 0 (v c))"
by (auto simp: DBM_val_bounded_def)
moreover from 6(2) have "v c > 0" by auto
ultimately show ?case by auto
qed
lemma dbm_abstr_zone_eq:
assumes "clock_numbering' v n" "∀c∈collect_clks cc. v c ≤ n"
shows "[abstr cc (λi j. ∞) v]⇘v,n⇙ = {u. u ⊢ cc}"
using dbm_abstr_soundness dbm_abstr_completeness assms unfolding DBM_zone_repr_def by metis
section ‹Zone Intersection›
lemma DBM_and_complete:
assumes "DBM_val_bounded v u M1 n" "DBM_val_bounded v u M2 n"
shows "DBM_val_bounded v u (And M1 M2) n"
using assms unfolding DBM_val_bounded_def by (auto simp: min_def)
lemma DBM_and_sound1:
assumes "DBM_val_bounded v u (And M1 M2) n"
shows "DBM_val_bounded v u M1 n"
unfolding DBM_val_bounded_def
using assms
proof (safe, goal_cases)
case 1
then show ?case unfolding DBM_val_bounded_def by (auto simp: less_eq[symmetric])
next
case (2 c)
then have "(And M1 M2) 0 (v c) ≤ M1 0 (v c)" by simp
from dbm_entry_val_mono_2[folded less_eq, OF _ this, of u] 2 show ?case
unfolding DBM_val_bounded_def by auto
next
case (3 c)
then have "(And M1 M2) (v c) 0 ≤ M1 (v c) 0" by simp
from dbm_entry_val_mono_3[folded less_eq, OF _ this, of u] 3 show ?case
unfolding DBM_val_bounded_def by auto
next
case (4 c1 c2)
then have "(And M1 M2) (v c1) (v c2) ≤ M1 (v c1) (v c2)" by simp
from dbm_entry_val_mono_1[folded less_eq, OF _ this, of u] 4 show ?case
unfolding DBM_val_bounded_def by auto
qed
lemma DBM_and_sound2:
assumes "DBM_val_bounded v u (And M1 M2) n"
shows "DBM_val_bounded v u M2 n"
unfolding DBM_val_bounded_def
using assms
proof (safe, goal_cases)
case 1
then show ?case unfolding DBM_val_bounded_def by (auto simp: less_eq[symmetric])
next
case (2 c)
then have "(And M1 M2) 0 (v c) ≤ M2 0 (v c)" by simp
from dbm_entry_val_mono_2[folded less_eq, OF _ this, of u] 2 show ?case
unfolding DBM_val_bounded_def by auto
next
case (3 c)
then have "(And M1 M2) (v c) 0 ≤ M2 (v c) 0" by simp
from dbm_entry_val_mono_3[folded less_eq, OF _ this, of u] 3 show ?case
unfolding DBM_val_bounded_def by auto
next
case (4 c1 c2)
then have "(And M1 M2) (v c1) (v c2) ≤ M2 (v c1) (v c2)" by simp
from dbm_entry_val_mono_1[folded less_eq, OF _ this, of u] 4 show ?case
unfolding DBM_val_bounded_def by auto
qed
section ‹Clock Reset›
definition
DBM_reset :: "('t :: time) DBM ⇒ nat ⇒ nat ⇒ 't ⇒ 't DBM ⇒ bool"
where
"DBM_reset M n k d M' ≡
(∀ j ≤ n. 0 < j ∧ k ≠ j⟶ M' k j = ∞ ∧ M' j k = ∞) ∧ M' k 0 = Le d ∧ M' 0 k = Le (- d)
∧ M' k k = M k k
∧ (∀i ≤ n. ∀j ≤ n.
i ≠ k ∧ j ≠ k ⟶ M' i j = min (dbm_add (M i k) (M k j)) (M i j))"
lemma DBM_reset_mono:
assumes "DBM_reset M n k d M'" "i ≤ n" "j ≤ n" "i ≠ k" "j ≠ k"
shows "M' i j ≤ M i j"
using assms unfolding DBM_reset_def by auto
lemma DBM_reset_len_mono:
assumes "DBM_reset M n k d M'" "k ∉ set xs" "i ≠ k" "j ≠ k" "set (i # j # xs) ⊆ {0..n}"
shows "len M' i j xs ≤ len M i j xs"
using assms by (induction xs arbitrary: i) (auto intro: add_mono DBM_reset_mono)
lemma DBM_reset_neg_cycle_preservation:
assumes "DBM_reset M n k d M'" "len M i i xs < Le 0" "set (k # i # xs) ⊆ {0..n}"
shows "∃ j. ∃ ys. set (j # ys) ⊆ {0..n} ∧ len M' j j ys < Le 0"
proof (cases "xs = []")
case Nil: True
show ?thesis
proof (cases "k = i")
case True
with Nil assms have "len M' i i [] < Le 0" unfolding DBM_reset_def by auto
moreover from assms have "set (i # []) ⊆ {0..n}" by auto
ultimately show ?thesis by blast
next
case False
with Nil assms DBM_reset_mono have "len M' i i [] < Le 0" by fastforce
moreover from assms have "set (i # []) ⊆ {0..n}" by auto
ultimately show ?thesis by blast
qed
next
case False
with assms obtain j ys where cycle:
"len M j j ys < Le 0" "distinct (j # ys)" "j ∈ set (i # xs)" "set ys ⊆ set xs"
by (metis negative_len_shortest neutral)
show ?thesis
proof (cases "k ∈ set (j # ys)")
case False
with cycle assms have "len M' j j ys ≤ len M j j ys" by - (rule DBM_reset_len_mono, auto)
moreover from cycle assms have "set (j # ys) ⊆ {0..n}" by auto
ultimately show ?thesis using cycle(1) by fastforce
next
case True
then obtain l where l: "(l, k) ∈ set (arcs j j ys)"
proof (cases "j = k", goal_cases)
case True
show ?thesis
proof (cases "ys = []")
case T: True
with True show ?thesis by (auto intro: that)
next
case False
then obtain z zs where "ys = zs @ [z]" by (metis append_butlast_last_id)
from arcs_decomp[OF this] True show ?thesis by (auto intro: that)
qed
next
case False
from arcs_set_elem2[OF False True] show ?thesis by (blast intro: that)
qed
show ?thesis
proof (cases "ys = []")
case False
from cycle_rotate_2'[OF False l, of M] cycle(1) obtain zs where rotated:
"len M l l (k # zs) < Le 0" "set (l # k # zs) = set (j # ys)" "1 + length zs = length ys"
by auto
with length_eq_distinct[OF this(2)[symmetric] cycle(2)] have "distinct (l # k # zs)" by auto
note rotated = rotated(1,2) this
from this(2) cycle(3,4) assms(3) have n_bound: "set (l # k # zs) ⊆ {0..n}" by auto
then have "l ≤ n" by auto
show ?thesis
proof (cases zs)
case Nil
with rotated have "M l k + M k l < Le 0" "l ≠ k" by auto
with assms(1) ‹l ≤ n› have "M' l l < Le 0" unfolding DBM_reset_def mult min_def by auto
with ‹l ≤ n› have "len M' l l [] < Le 0" "set [l] ⊆ {0..n}" by auto
then show ?thesis by blast
next
case (Cons w ws)
with n_bound have *: "set (w # l # ws) ⊆ {0..n}" by auto
from Cons n_bound rotated(3) have "w ≤ n" "w ≠ k" "l ≠ k" by auto
with assms(1) ‹l ≤ n› have
"M' l w ≤ M l k + M k w"
unfolding DBM_reset_def mult min_def by auto
moreover from Cons rotated assms * have
"len M' w l ws ≤ len M w l ws"
by - (rule DBM_reset_len_mono, auto)
ultimately have
"len M' l l zs ≤ len M l l (k # zs)"
using Cons by (auto intro: add_mono simp add: assoc[symmetric])
with n_bound rotated(1) show ?thesis by fastforce
qed
next
case T: True
with True cycle have "M j j < Le 0" "j = k" by auto
with assms(1) have "len M' k k [] < Le 0" unfolding DBM_reset_def by simp
moreover from assms(3) have "set (k # []) ⊆ {0..n}" by auto
ultimately show ?thesis by blast
qed
qed
qed
text ‹Implementation of DBM reset›
definition reset :: "('t::time) DBM ⇒ nat ⇒ nat ⇒ 't ⇒ 't DBM"
where
"reset M n k d =
(λ i j.
if i = k ∧ j = 0 then Le d
else if i = 0 ∧ j = k then Le (-d)
else if i = k ∧ j ≠ k then ∞
else if i ≠ k ∧ j = k then ∞
else if i = k ∧ j = k then M k k
else min (dbm_add (M i k) (M k j)) (M i j)
)"
fun reset' :: "('t::time) DBM ⇒ nat ⇒ 'c list ⇒ ('c ⇒ nat) ⇒ 't ⇒ 't DBM"
where
"reset' M n [] v d = M" |
"reset' M n (c # cs) v d = reset (reset' M n cs v d) n (v c) d"
lemma DBM_reset_reset:
"0 < k ⟹ k ≤ n ⟹ DBM_reset M n k d (reset M n k d)"
unfolding DBM_reset_def by (auto simp: reset_def)
lemma DBM_reset_complete:
assumes "clock_numbering' v n" "v c ≤ n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M n"
shows "DBM_val_bounded v (u(c := d)) M' n"
unfolding DBM_val_bounded_def using assms
proof (auto, goal_cases)
case 1
then have *: "M 0 0 ≥ Le 0" unfolding DBM_val_bounded_def less_eq by auto
from 1 have **: "M' 0 0 = min (M 0 (v c) + M (v c) 0) (M 0 0)" unfolding DBM_reset_def mult by auto
show ?case
proof (cases "M 0 (v c) + M (v c) 0 ≤ M 0 0")
case False
with * ** show ?thesis unfolding min_def less_eq by auto
next
case True
have "dbm_entry_val u (Some c) (Some c) (M (v c) 0 + M 0 (v c))"
by (metis DBM_val_bounded_def assms(2,4) dbm_entry_val_add_4 mult)
then have "M (v c) 0 + M 0 (v c) ≥ Le 0"
unfolding less_eq dbm_le_def by (cases "M (v c) 0 + M 0 (v c)") auto
with True ** have "M' 0 0 ≥ Le 0" by (simp add: comm)
then show ?thesis unfolding less_eq .
qed
next
case (2 c')
show ?case
proof (cases "c = c'")
case False
hence F:"v c' ≠ v c" using 2 by metis
hence *:"M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c'))"
using F 2(1,2,4,6) unfolding DBM_reset_def by simp
show ?thesis
proof (cases "dbm_add (M 0 (v c)) (M (v c) (v c')) < M 0 (v c')")
case False
with * have "M' 0 (v c') = M 0 (v c')" by (auto split: split_min)
hence "dbm_entry_val u None (Some c') (M' 0 (v c'))"
using 2(3,6) unfolding DBM_val_bounded_def by auto
thus ?thesis using F by cases fastforce+
next
case True
with * have **:"M' 0 (v c') = dbm_add (M 0 (v c)) (M (v c) (v c'))" by (auto split: split_min)
from 2 have "dbm_entry_val u None (Some c) (M 0 (v c))"
"dbm_entry_val u (Some c) (Some c') (M (v c) (v c'))"
unfolding DBM_val_bounded_def by auto
thus ?thesis
proof (cases, auto simp add: **, goal_cases)
case (1 d)
note G1 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from this(2) G1(3) have "- u c' ≤ d + d'"
by (metis diff_minus_eq_add less_diff_eq less_le_trans minus_diff_eq minus_le_iff not_le)
thus ?case using 1 ‹c ≠ c'› by fastforce
next
case (2 d')
from this(2) G1(3) have "u c - u c' - u c < d + d'" using add_le_less_mono by fastforce
hence "- u c' < d + d'" by simp
thus ?case using 2 ‹c ≠ c'› by fastforce
next
case (3) thus ?case by auto
qed
next
case (2 d)
note G2 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from this(2) G2(3) have "u c - u c' - u c < d' + d" using add_le_less_mono by fastforce
hence "- u c' < d' + d" by simp
hence "- u c' < d + d'"
by (metis (hide_lams, no_types) diff_0_right diff_minus_eq_add minus_add_distrib minus_diff_eq)
thus ?case using 1 ‹c ≠ c'› by fastforce
next
case (2 d')
from this(2) G2(3) have "u c - u c' - u c < d + d'" using add_strict_mono by fastforce
hence "- u c' < d + d'" by simp
thus ?case using 2 ‹c ≠ c'› by fastforce
next
case (3) thus ?case by auto
qed
qed
qed
next
case True
with 2 show ?thesis unfolding DBM_reset_def by auto
qed
next
case (3 c')
show ?case
proof (cases "c = c'")
case False
hence F:"v c' ≠ v c" using 3 by metis
hence *:"M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0)"
using F 3(1,2,4,6) unfolding DBM_reset_def by simp
show ?thesis
proof (cases "dbm_add (M (v c') (v c)) (M (v c) 0) < M (v c') 0")
case False
with * have "M' (v c') 0 = M (v c') 0" by (auto split: split_min)
hence "dbm_entry_val u (Some c') None (M' (v c') 0)"
using 3(3,6) unfolding DBM_val_bounded_def by auto
thus ?thesis using F by cases fastforce+
next
case True
with * have **:"M' (v c') 0 = dbm_add (M (v c') (v c)) (M (v c) 0)" by (auto split: split_min)
from 3 have "dbm_entry_val u (Some c') (Some c) (M (v c') (v c))"
"dbm_entry_val u (Some c) None (M (v c) 0)"
unfolding DBM_val_bounded_def by auto
thus ?thesis
proof (cases, auto simp add: **, goal_cases)
case (1 d)
note G1 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from this(2) G1(3) have "u c' ≤ d + d'" using ordered_ab_semigroup_add_class.add_mono
by fastforce
thus ?case using 1 ‹c ≠ c'› by fastforce
next
case (2 d')
from this(2) G1(3) have "u c + u c' - u c < d + d'" using add_le_less_mono by fastforce
hence "u c' < d + d'" by simp
thus ?case using 2 ‹c ≠ c'› by fastforce
next
case (3) thus ?case by auto
qed
next
case (2 d)
note G2 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from this(2) G2(3) have "u c + u c' - u c < d' + d" using add_le_less_mono by fastforce
hence "u c' < d' + d" by simp
hence "u c' < d + d'"
by (metis (hide_lams, no_types) diff_0_right diff_minus_eq_add minus_add_distrib minus_diff_eq)
thus ?case using 1 ‹c ≠ c'› by fastforce
next
case (2 d')
from this(2) G2(3) have "u c + u c' - u c < d + d'" using add_strict_mono by fastforce
hence "u c' < d + d'" by simp
thus ?case using 2 ‹c ≠ c'› by fastforce
next
case 3 thus ?case by auto
qed
qed
qed
next
case True
with 3 show ?thesis unfolding DBM_reset_def by auto
qed
next
case (4 c1 c2)
show ?case
proof (cases "c = c1")
case False
note F1 = this
show ?thesis
proof (cases "c = c2")
case False
with F1 4 have F: "v c ≠ v c1" "v c ≠ v c2" "v c1 ≠ 0" "v c2 ≠ 0" by force+
hence *:"M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using 4(1,2,6,7) unfolding DBM_reset_def by simp
show ?thesis
proof (cases "dbm_add (M (v c1) (v c)) (M (v c) (v c2)) < M (v c1) (v c2)")
case False
with * have "M' (v c1) (v c2) = M (v c1) (v c2)" by (auto split: split_min)
hence "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
using 4(3,6,7) unfolding DBM_val_bounded_def by auto
thus ?thesis using F by cases fastforce+
next
case True
with * have **:"M' (v c1) (v c2) = dbm_add (M (v c1) (v c)) (M (v c) (v c2))" by (auto split: split_min)
from 4 have "dbm_entry_val u (Some c1) (Some c) (M (v c1) (v c))"
"dbm_entry_val u (Some c) (Some c2) (M (v c) (v c2))" unfolding DBM_val_bounded_def by auto
thus ?thesis
proof (cases, auto simp add: **, goal_cases)
case (1 d)
note G1 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from this(2) G1(3) have "u c1 - u c2 ≤ d + d'"
by (metis (hide_lams, no_types) ab_semigroup_add_class.add_ac(1) add_le_cancel_right
add_left_mono diff_add_cancel dual_order.refl dual_order.trans)
thus ?case using 1 ‹c ≠ c1› ‹c ≠ c2› by fastforce
next
case (2 d')
from add_less_le_mono[OF this(2) G1(3)] have "- u c2 + u c1 < d' + d" by simp
hence "u c1 - u c2 < d + d'" by (simp add: add.commute)
thus ?case using 2 ‹c ≠ c1› ‹c ≠ c2› by fastforce
next
case (3) thus ?case by auto
qed
next
case (2 d)
note G2 = this
from this(2) show ?case
proof (cases, goal_cases)
case (1 d')
from add_less_le_mono[OF G2(3) this(2)] have "u c1 - u c2 < d + d'"
by (metis (hide_lams, no_types) ab_semigroup_add_class.add_ac(1) add_le_cancel_right
diff_add_cancel dual_order.order_iff_strict dual_order.strict_trans2)
thus ?case using 1 ‹c ≠ c1› ‹c ≠ c2› by fastforce
next
case (2 d')
from add_strict_mono[OF this(2) G2(3)] have "- u c2 + u c1 < d' + d" by simp
hence "- u c2 + u c1 < d + d'"
by (metis (full_types) diff_0 diff_minus_eq_add minus_add_distrib minus_diff_eq)
hence "u c1 - u c2 < d + d'" by (metis add_diff_cancel_left diff_0 diff_0_right diff_add_cancel)
thus ?case using 2 ‹c ≠ c1› ‹c ≠ c2› by fastforce
next
case (3) thus ?case by auto
qed
qed
qed
next
case True
with F1 4 have F: "v c ≠ v c1" "v c1 ≠ 0" "v c2 ≠ 0" by force+
thus ?thesis using 4(1,2,4,6,7) True unfolding DBM_reset_def by auto
qed
next
case True
note T1 = this
show ?thesis
proof (cases "c = c2")
case False
with T1 4 have F: "v c ≠ v c2" "v c1 ≠ 0" "v c2 ≠ 0" by force+
thus ?thesis using 4(1,2,7) True unfolding DBM_reset_def by auto
next
case True
then have *: "M' (v c1) (v c1) = M (v c1) (v c1)"
using T1 4 unfolding DBM_reset_def by auto
from 4(1,3) True T1 have "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))"
unfolding DBM_val_bounded_def by auto
then show ?thesis by (cases rule: dbm_entry_val.cases, auto simp: * True[symmetric] T1)
qed
qed
qed
lemma DBM_reset_sound_empty:
assumes "clock_numbering' v n" "v c ≤ n" "DBM_reset M n (v c) d M'"
"∀ u . ¬ DBM_val_bounded v u M' n"
shows "¬ DBM_val_bounded v u M n"
using assms DBM_reset_complete by metis
lemma DBM_reset_diag_preservation:
"∀k≤n. M k k ≤ 𝟭 ⟹ DBM_reset M n i d M' ⟹ ∀k≤n. M' k k ≤ 𝟭"
apply auto
apply (case_tac "k = i")
apply (simp add: DBM_reset_def less[symmetric])
apply (case_tac "k = 0")
by (auto simp add: DBM_reset_def less[symmetric] neutral split: split_min)
lemma FW_diag_preservation:
"∀k≤n. M k k ≤ 𝟭 ⟹ ∀k≤n. (FW M n) k k ≤ 𝟭"
proof clarify
fix k assume A: "∀k≤n. M k k ≤ 𝟭" "k ≤ n"
then have "M k k ≤ 𝟭" by auto
with fw_mono[of n n n k k M n] A show "FW M n k k ≤ 𝟭" by auto
qed
lemma DBM_reset_not_cyc_free_preservation:
assumes "¬ cyc_free M n" "DBM_reset M n k d M'" "k ≤ n"
shows "¬ cyc_free M' n"
proof -
from assms(1) obtain i xs where "i ≤ n" "set xs ⊆ {0..n}" "len M i i xs < Le 0"
unfolding neutral by auto
with DBM_reset_neg_cycle_preservation[OF assms(2) this(3)] assms(3) obtain j ys where
"set (j # ys) ⊆ {0..n}" "len M' j j ys < Le 0"
by auto
then show ?thesis unfolding neutral by force
qed
lemma DBM_reset_complete_empty':
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering v" "k ≤ n"
"DBM_reset M n k d M'" "∀ u . ¬ DBM_val_bounded v u M n"
shows "¬ DBM_val_bounded v u M' n"
proof -
from assms(5) have "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
from empty_not_cyc_free[OF _ this] have "¬ cyc_free M n" using assms(2) by auto
from DBM_reset_not_cyc_free_preservation[OF this assms(4,3)] have "¬ cyc_free M' n" by auto
then obtain i xs where "i ≤ n" "set xs ⊆ {0..n}" "len M' i i xs < 𝟭" by auto
from DBM_val_bounded_neg_cycle[OF _ this assms(1)] show ?thesis by fast
qed
lemma DBM_reset_complete_empty:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering v"
"DBM_reset (FW M n) n (v c) d M'" "∀ u . ¬ DBM_val_bounded v u (FW M n) n"
shows "¬ DBM_val_bounded v u M' n"
proof -
note A = assms
from A(4) have "[FW M n]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
with FW_detects_empty_zone[OF A(1), of M] A(2)
obtain i where i: "i ≤ n" "FW M n i i < Le 0" by blast
with A(3,4) have "M' i i < Le 0"
unfolding DBM_reset_def by (cases "i = v c", auto split: split_min)
with fw_mono[of n n n i i M' n] i have "FW M' n i i < Le 0" by auto
with FW_detects_empty_zone[OF A(1), of M'] A(2) i
have "[FW M' n]⇘v,n⇙ = {}" by auto
with FW_zone_equiv[OF A(1)] show ?thesis by (auto simp: DBM_zone_repr_def)
qed
lemma DBM_reset_complete_empty1:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering v"
"DBM_reset (FW M n) n (v c) d M'" "∀ u . ¬ DBM_val_bounded v u M n"
shows "¬ DBM_val_bounded v u M' n"
proof -
from assms have "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
with FW_zone_equiv[OF assms(1)] have
"∀ u . ¬ DBM_val_bounded v u (FW M n) n"
unfolding DBM_zone_repr_def by auto
from DBM_reset_complete_empty[OF assms(1-3) this] show ?thesis by auto
qed
text ‹
Lemma ‹FW_canonical_id› allows us to prove correspondences between reset and canonical,
like for the two below.
Can be left out for the rest because of the triviality of the correspondence.
›
lemma DBM_reset_empty'':
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "v c ≤ n"
"DBM_reset M n (v c) d M'"
shows "[M]⇘v,n⇙ = {} ⟷ [M']⇘v,n⇙ = {}"
proof
assume A: "[M]⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
hence "∀ u . ¬ DBM_val_bounded v u M' n"
using DBM_reset_complete_empty'[OF assms(1) _ assms(3,4)] assms(2) by auto
thus "[M']⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
next
assume "[M']⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u M' n" unfolding DBM_zone_repr_def by auto
hence "∀ u . ¬ DBM_val_bounded v u M n" using DBM_reset_sound_empty[OF assms(2-4)] by auto
thus "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
qed
lemma DBM_reset_empty:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "v c ≤ n"
"DBM_reset (FW M n) n (v c) d M'"
shows "[FW M n]⇘v,n⇙ = {} ⟷ [M']⇘v,n⇙ = {}"
proof
assume A: "[FW M n]⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u (FW M n) n" unfolding DBM_zone_repr_def by auto
hence "∀ u . ¬ DBM_val_bounded v u M' n"
using DBM_reset_complete_empty[of n v M, OF assms(1) _ assms(4)] assms(2,3) by auto
thus "[M']⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
next
assume "[M']⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u M' n" unfolding DBM_zone_repr_def by auto
hence "∀ u . ¬ DBM_val_bounded v u (FW M n) n" using DBM_reset_sound_empty[OF assms(2-)] by auto
thus "[FW M n]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
qed
lemma DBM_reset_empty':
assumes "canonical M n" "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "v c ≤ n"
"DBM_reset (FW M n) n (v c) d M'"
shows "[M]⇘v,n⇙ = {} ⟷ [M']⇘v,n⇙ = {}"
using FW_canonical_id[OF assms(1)] DBM_reset_empty[OF assms(2-)] by simp
lemma DBM_reset_sound':
assumes "clock_numbering' v n" "v c ≤ n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M' n"
"DBM_val_bounded v u'' M n"
obtains d' where "DBM_val_bounded v (u(c := d')) M n"
using assms
proof (auto, goal_cases)
case 1
note A = this
obtain S_Min_Le where S_Min_Le:
"S_Min_Le = {u c' - d | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = Le d}
∪ {-d | d. M 0 (v c) = Le d}" by auto
obtain S_Min_Lt where S_Min_Lt:
"S_Min_Lt = {u c' - d | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = Lt d}
∪ {-d | d. M 0 (v c) = Lt d}" by auto
obtain S_Max_Le where S_Max_Le:
"S_Max_Le = {u c' + d | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = Le d}
∪ {d | d. M (v c) 0 = Le d}" by auto
obtain S_Max_Lt where S_Max_Lt:
"S_Max_Lt = {u c' + d | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = Lt d}
∪ {d | d. M (v c) 0 = Lt d}" by auto
have "finite {c. 0 < v c ∧ v c ≤ n}" using A(6,7)
proof (induction n)
case 0
then have "{c. 0 < v c ∧ v c ≤ 0} = {}" by auto
then show ?case by (metis finite.emptyI)
next
case (Suc n)
then have "finite {c. 0 < v c ∧ v c ≤ n}" by auto
moreover have "{c. 0 < v c ∧ v c ≤ Suc n} = {c. 0 < v c ∧ v c ≤ n} ∪ {c. v c = Suc n}" by auto
moreover have "finite {c. v c = Suc n}"
proof (cases "{c. v c = Suc n} = {}", auto)
fix c assume "v c = Suc n"
then have "{c. v c = Suc n} = {c}" using Suc.prems(2) by auto
then show ?thesis by auto
qed
ultimately show ?case by auto
qed
then have "∀ f. finite {(c,b) | c b. 0 < v c ∧ v c ≤ n ∧ f M (v c) = b}" by auto
moreover have
"∀ f K. {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}
⊆ {(c,b) | c b. 0 < v c ∧ v c ≤ n ∧ f M (v c) = b}"
by auto
ultimately have B:
"∀ f K. finite {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}"
using finite_subset by fast
have "∀ f K. theLe o K = id ⟶ finite {(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}"
proof (auto, goal_cases)
case (1 f K)
then have
"{(c,d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}
= (λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}"
proof (auto simp add: pointfree_idE, goal_cases)
case (1 a b)
then have "(a, K b) ∈ {(c, K d) |c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d}" by auto
moreover from 1(1) have "theLe (K b) = b" by (simp add: pointfree_idE)
ultimately show ?case by force
qed
moreover from B have
"finite ((λ (c,b). (c, theLe b)) ` {(c,K d) | c d. 0 < v c ∧ v c ≤ n ∧ f M (v c) = K d})"
by auto
ultimately show ?case by auto
qed
then have finI:
"⋀ f g K. theLe o K = id ⟹ finite (g ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ f M (v c') = K d})"
by auto
have finI1:
"⋀ f g K. theLe o K = id ⟹ finite (g ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ f M (v c') = K d})"
proof goal_cases
case (1 f g K)
have
"g ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ f M (v c') = K d}
⊆ g ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ f M (v c') = K d}"
by auto
from finite_subset[OF this finI[OF 1, of g f]] show ?case .
qed
have "∀ f. finite {b. f M (v c) = b}" by auto
moreover have "∀ f K. {K d | d. f M (v c) = K d} ⊆ {b. f M (v c) = b}" by auto
ultimately have B: "∀ f K. finite {K d | d. f M (v c) = K d}" using finite_subset by fast
have "∀ f K. theLe o K = id ⟶ finite {d | d. f M (v c) = K d}"
proof (auto, goal_cases)
case (1 f K)
then have "{d | d. f M (v c) = K d} = theLe ` {K d | d. f M (v c) = K d}"
proof (auto simp add: pointfree_idE, goal_cases)
case (1 x)
have "K x ∈ {K d |d. K x = K d}" by auto
moreover from 1 have "theLe (K x) = x" by (simp add: pointfree_idE)
ultimately show ?case by auto
qed
moreover from B have "finite {K d |d. f M (v c) = K d}" by auto
ultimately show ?case by auto
qed
then have C: "∀ f g K. theLe o K = id ⟶ finite (g ` {d | d. f M (v c) = K d})" by auto
have finI2: "⋀ f g K. theLe o K = id ⟹ finite ({g d | d. f M (v c) = K d})"
proof goal_cases
case (1 f g K)
have "{g d |d. f M (v c) = K d} = g ` {d | d. f M (v c) = K d}" by auto
with C 1 show ?case by auto
qed
{ fix K :: "'b ⇒ 'b DBMEntry" assume A: "theLe o K = id"
then have
"finite ((λ(c,d). u c - d) ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = K d})"
by (intro finI1, auto)
moreover have
"{u c' - d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = K d}
= ((λ(c,d). u c - d) ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = K d})"
by auto
ultimately have "finite {u c' - d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = K d}"
by auto
moreover have "finite {- d |d. M 0 (v c) = K d}" using A by (intro finI2, auto)
ultimately have
"finite ({u c' - d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c') (v c) = K d}
∪ {- d |d. M 0 (v c) = K d})"
by (auto simp: S_Min_Le)
} note fin1 = this
have fin_min_le: "finite S_Min_Le" unfolding S_Min_Le by (rule fin1, auto)
have fin_min_lt: "finite S_Min_Lt" unfolding S_Min_Lt by (rule fin1, auto)
{ fix K :: "'b ⇒ 'b DBMEntry" assume A: "theLe o K = id"
then have "finite ((λ(c,d). u c + d) ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = K d})"
by (intro finI1, auto)
moreover have
"{u c' + d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = K d}
= ((λ(c,d). u c + d) ` {(c',d) | c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = K d})"
by auto
ultimately have "finite {u c' + d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = K d}"
by auto
moreover have "finite {d |d. M (v c) 0 = K d}" using A by (intro finI2, auto)
ultimately have
"finite ({u c' + d |c' d. 0 < v c' ∧ v c' ≤ n ∧ c ≠ c' ∧ M (v c) (v c') = K d}
∪ {d |d. M (v c) 0 = K d})"
by (auto simp: S_Min_Le)
} note fin2 = this
have fin_max_le: "finite S_Max_Le" unfolding S_Max_Le by (rule fin2, auto)
have fin_max_lt: "finite S_Max_Lt" unfolding S_Max_Lt by (rule fin2, auto)
{ fix l r assume "l ∈ S_Min_Le" "r ∈ S_Max_Le"
then have "l ≤ r"
proof (auto simp: S_Min_Le S_Max_Le, goal_cases)
case (1 c1 d1 c2 d2)
with A have
"dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
unfolding DBM_val_bounded_def by presburger
moreover have
"M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using A(3,7) 1 unfolding DBM_reset_def by metis
ultimately have
"dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
using dbm_entry_dbm_min' by auto
with 1 have "u c1 - u c2 ≤ d1 + d2" by auto
thus ?case
by (metis (hide_lams, no_types) add_diff_cancel_left diff_0_right diff_add_cancel diff_eq_diff_less_eq)
next
case (2 c' d)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
using 2 by blast
moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
using dbm_entry_dbm_min3' by fastforce
with 2 have "u c' ≤ d + r" by auto
thus ?case by (metis add_diff_cancel_left add_le_cancel_right diff_0_right diff_add_cancel)
next
case (3 d c' d')
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
using 3 by blast
moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
using dbm_entry_dbm_min2' by fastforce
with 3 have "-u c' ≤ d + d'" by auto
thus ?case
by (metis add_uminus_conv_diff diff_le_eq minus_add_distrib minus_le_iff)
next
case (4 d)
text ‹
Here is the reason we need the assumption that the zone was not empty before the reset.
We cannot deduce anything from the current value of ‹c› itself because we reset it.
We can only ensure that we can reset the value of ‹c› by using the value from the
alternative assignment.
This case is only relevant if the tightest bounds for ‹d› were given by its original
lower and upper bounds. If they would overlap, the original zone would be empty.
›
from A(2,5) have
"dbm_entry_val u'' None (Some c) (M 0 (v c))"
"dbm_entry_val u'' (Some c) None (M (v c) 0)"
unfolding DBM_val_bounded_def by auto
with 4 have "- u'' c ≤ d" "u'' c ≤ r" by auto
thus ?case by (metis minus_le_iff order.trans)
qed
} note EE = this
{ fix l r assume "l ∈ S_Min_Le" "r ∈ S_Max_Lt"
then have "l < r"
proof (auto simp: S_Min_Le S_Max_Lt, goal_cases)
case (1 c1 d1 c2 d2)
with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
unfolding DBM_val_bounded_def by presburger
moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using A(3,7) 1 unfolding DBM_reset_def by metis
ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
using dbm_entry_dbm_min' by fastforce
with 1 have "u c1 - u c2 < d1 + d2" by auto
then show ?case by (metis add.assoc add.commute diff_less_eq)
next
case (2 c' d)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
using 2 by blast
moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
using dbm_entry_dbm_min3' by fastforce
with 2 have "u c' < d + r" by auto
thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
next
case (3 d c' da)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
using 3 by blast
moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
using dbm_entry_dbm_min2' by fastforce
with 3 have "-u c' < d + da" by auto
thus ?case by (metis add.commute diff_less_eq uminus_add_conv_diff)
next
case (4 d)
from A(2,5) have
"dbm_entry_val u'' None (Some c) (M 0 (v c))"
"dbm_entry_val u'' (Some c) None (M (v c) 0)"
unfolding DBM_val_bounded_def by auto
with 4 have "- u'' c ≤ d" "u'' c < r" by auto
thus ?case by (metis minus_le_iff neq_iff not_le order.strict_trans)
qed
} note EL = this
{ fix l r assume "l ∈ S_Min_Lt" "r ∈ S_Max_Le"
then have "l < r"
proof (auto simp: S_Min_Lt S_Max_Le, goal_cases)
case (1 c1 d1 c2 d2)
with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
unfolding DBM_val_bounded_def by presburger
moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using A(3,7) 1 unfolding DBM_reset_def by metis
ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
using dbm_entry_dbm_min' by fastforce
with 1 have "u c1 - u c2 < d1 + d2" by auto
thus ?case by (metis add.assoc add.commute diff_less_eq)
next
case (2 c' d)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
using 2 by blast
moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
using dbm_entry_dbm_min3' by fastforce
with 2 have "u c' < d + r" by auto
thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
next
case (3 d c' da)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
using 3 by blast
moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
using dbm_entry_dbm_min2' by fastforce
with 3 have "-u c' < d + da" by auto
thus ?case by (metis add.commute diff_less_eq uminus_add_conv_diff)
next
case (4 d)
from A(2,5) have
"dbm_entry_val u'' None (Some c) (M 0 (v c))"
"dbm_entry_val u'' (Some c) None (M (v c) 0)"
unfolding DBM_val_bounded_def by auto
with 4 have "- u'' c < d" "u'' c ≤ r" by auto
thus ?case by (meson less_le_trans minus_less_iff)
qed
} note LE = this
{ fix l r assume "l ∈ S_Min_Lt" "r ∈ S_Max_Lt"
then have "l < r"
proof (auto simp: S_Min_Lt S_Max_Lt, goal_cases)
case (1 c1 d1 c2 d2)
with A have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
unfolding DBM_val_bounded_def by presburger
moreover have "M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using A(3,7) 1 unfolding DBM_reset_def by metis
ultimately have "dbm_entry_val u (Some c1) (Some c2) (dbm_add (M (v c1) (v c)) (M (v c) (v c2)))"
using dbm_entry_dbm_min' by fastforce
with 1 have "u c1 - u c2 < d1 + d2" by auto
then show ?case by (metis add.assoc add.commute diff_less_eq)
next
case (2 c' d)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0⟶ M' i 0 = min (dbm_add (M i (v c)) (M (v c) 0)) (M i 0))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0))"
using 2 by blast
moreover from A 2 have "dbm_entry_val u (Some c') None (M' (v c') 0)"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u (Some c') None (dbm_add (M (v c') (v c)) (M (v c) 0))"
using dbm_entry_dbm_min3' by fastforce
with 2 have "u c' < d + r" by auto
thus ?case by (metis add_less_imp_less_right diff_add_cancel gt_swap)
next
case (3 d c' da)
with A have
"(∀i≤n. i ≠ v c ∧ i > 0 ⟶ M' 0 i = min (dbm_add (M 0 (v c)) (M (v c) i)) (M 0 i))"
"v c' ≠ v c"
unfolding DBM_reset_def by auto
hence "(M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c')))"
using 3 by blast
moreover from A 3 have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
unfolding DBM_val_bounded_def by presburger
ultimately have "dbm_entry_val u None (Some c') (dbm_add (M 0 (v c)) (M (v c) (v c')))"
using dbm_entry_dbm_min2' by fastforce
with 3 have "-u c' < d + da" by auto
thus ?case by (metis ab_group_add_class.ab_diff_conv_add_uminus add.commute diff_less_eq)
next
case (4 d)
from A(2,5) have
"dbm_entry_val u'' None (Some c) (M 0 (v c))"
"dbm_entry_val u'' (Some c) None (M (v c) 0)"
unfolding DBM_val_bounded_def by auto
with 4 have "- u'' c ≤ d" "u'' c < r" by auto
thus ?case by (metis minus_le_iff neq_iff not_le order.strict_trans)
qed
} note LL = this
obtain d' where d':
"∀ t ∈ S_Min_Le. d' ≥ t" "∀ t ∈ S_Min_Lt. d' > t"
"∀ t ∈ S_Max_Le. d' ≤ t" "∀ t ∈ S_Max_Lt. d' < t"
proof -
assume m:
"⋀d'. ⟦∀t∈S_Min_Le. t ≤ d'; ∀t∈S_Min_Lt. t < d'; ∀t∈S_Max_Le. d' ≤ t; ∀t∈S_Max_Lt. d' < t⟧
⟹ thesis"
let ?min_le = "Max S_Min_Le"
let ?min_lt = "Max S_Min_Lt"
let ?max_le = "Min S_Max_Le"
let ?max_lt = "Min S_Max_Lt"
show thesis
proof (cases "S_Min_Le = {} ∧ S_Min_Lt = {}")
case True
note T = this
show thesis
proof (cases "S_Max_Le = {} ∧ S_Max_Lt = {}")
case True
let ?d' = "0 :: 't :: time"
show thesis using True T by (intro m[of ?d']) auto
next
case False
let ?d =
"if S_Max_Le ≠ {}
then if S_Max_Lt ≠ {} then min ?max_lt ?max_le else ?max_le
else ?max_lt"
obtain a :: "'b" where a: "a < 0" using non_trivial_neg by auto
let ?d' = "min 0 (?d + a)"
{ fix x assume "x ∈ S_Max_Le"
with fin_max_le a have "min 0 (Min S_Max_Le + a) ≤ x"
by (metis Min.boundedE add_le_same_cancel1 empty_iff less_imp_le min.coboundedI2)
then have "min 0 (Min S_Max_Le + a) ≤ x" by auto
} note 1 = this
{ fix x assume x: "x ∈ S_Max_Lt"
have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < ?max_lt"
by (meson a add_less_same_cancel1 min.cobounded1 min.strict_coboundedI2 order.strict_trans2)
also from fin_max_lt x have "… ≤ x" by auto
finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) < x" .
} note 2 = this
{ fix x assume x: "x ∈ S_Max_Le"
have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) ≤ ?max_le"
by (metis le_add_same_cancel1 linear not_le a min_le_iff_disj)
also from fin_max_le x have "… ≤ x" by auto
finally have "min 0 (min (Min S_Max_Lt) (Min S_Max_Le) + a) ≤ x" .
} note 3 = this
show thesis using False T a 1 2 3
proof ((intro m[of ?d']), auto, goal_cases)
case 1 then show ?case
by (metis Min.in_idem add.commute fin_max_lt leD le_add_same_cancel2 min.orderI
min_less_iff_disj not_less_iff_gr_or_eq)
qed
qed
next
case False
note F = this
show thesis
proof (cases "S_Max_Le = {} ∧ S_Max_Lt = {}")
case True
let ?l =
"if S_Min_Le ≠ {}
then if S_Min_Lt ≠ {} then max ?min_lt ?min_le else ?min_le
else ?min_lt"
obtain a :: "'b" where "a < 0" using non_trivial_neg by blast
then have a: "-a > 0" using non_trivial_neg by simp
then obtain a :: "'b" where a: "a > 0" by blast
let ?d' = "?l + a"
{
fix x assume x: "x ∈ S_Min_Le"
then have "x ≤ max ?min_lt ?min_le" "x ≤ ?min_le" using fin_min_le by (simp add: max.coboundedI2)+
then have "x ≤ max ?min_lt ?min_le + a" "x ≤ ?min_le + a" using a by (simp add: add_increasing2)+
} note 1 = this
{
fix x assume x: "x ∈ S_Min_Lt"
then have "x ≤ max ?min_lt ?min_le" "x ≤ ?min_lt" using fin_min_lt by (simp add: max.coboundedI1)+
then have "x < ?d'" using a x by (auto simp add: add.commute add_strict_increasing)
} note 2 = this
show thesis using True F a 1 2 by ((intro m[of ?d']), auto)
next
case False
let ?r =
"if S_Max_Le ≠ {}
then if S_Max_Lt ≠ {} then min ?max_lt ?max_le else ?max_le
else ?max_lt"
let ?l =
"if S_Min_Le ≠ {}
then if S_Min_Lt ≠ {} then max ?min_lt ?min_le else ?min_le
else ?min_lt"
have 1: "x ≤ max ?min_lt ?min_le" "x ≤ ?min_le" if "x ∈ S_Min_Le" for x
by (simp add: max.coboundedI2 that fin_min_le)+
{
fix x y assume x: "x ∈ S_Max_Le" "y ∈ S_Min_Lt"
then have "S_Min_Lt ≠ {}" by auto
from LE[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt ≤ x" by auto
} note 3 = this
{
fix x y assume x: "x ∈ S_Max_Le" "y ∈ S_Min_Le"
with EE[OF Max_in[OF fin_min_le], OF _ x(1)] have "?min_le ≤ x" by auto
} note 4 = this
{
fix x y assume x: "x ∈ S_Max_Lt" "y ∈ S_Min_Lt"
then have "S_Min_Lt ≠ {}" by auto
from LL[OF Max_in[OF fin_min_lt], OF this, OF x(1)] have "?min_lt < x" by auto
} note 5 = this
{
fix x y assume x: "x ∈ S_Max_Lt" "y ∈ S_Min_Le"
then have "S_Min_Le ≠ {}" by auto
from EL[OF Max_in[OF fin_min_le], OF this, OF x(1)] have "?min_le < x" by auto
} note 6 = this
show thesis
proof (cases "?l < ?r")
case False
then have *: "S_Max_Le ≠ {}"
proof (auto, goal_cases)
case 1
with ‹¬ (S_Max_Le = {} ∧ S_Max_Lt = {})› obtain y where y:"y ∈ S_Max_Lt" by auto
note 1 = 1 this
{ fix x y assume A: "x ∈ S_Min_Le" "y ∈ S_Max_Lt"
with EL[OF Max_in[OF fin_min_le] Min_in[OF fin_max_lt]]
have "Max S_Min_Le < Min S_Max_Lt" by auto
} note ** = this
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Lt"
with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
have "Max S_Min_Lt < Min S_Max_Lt" by auto
} note *** = this
show ?case
proof (cases "S_Min_Le ≠ {}")
case True
note T = this
show ?thesis
proof (cases "S_Min_Lt ≠ {}")
case True
then show False using 1 T True ** *** by auto
next
case False with 1 T ** show False by auto
qed
next
case False
with 1 False *** ‹¬ (S_Min_Le = {} ∧ S_Min_Lt = {})› show ?thesis by auto
qed
qed
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Lt"
with LL[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_lt]]
have "Max S_Min_Lt < Min S_Max_Lt" by auto
} note *** = this
{ fix x y assume A: "x ∈ S_Min_Lt" "y ∈ S_Max_Le"
with LE[OF Max_in[OF fin_min_lt] Min_in[OF fin_max_le]]
have "Max S_Min_Lt < Min S_Max_Le" by auto
} note **** = this
from F False have **: "S_Min_Le ≠ {}"
proof (auto, goal_cases)
case 1
show ?case
proof (cases "S_Max_Le ≠ {}")
case True
note T = this
show ?thesis
proof (cases "S_Max_Lt ≠ {}")
case True
then show False using 1 T True **** *** by auto
next
case False with 1 T **** show False by auto
qed
next
case False
with 1 False *** ‹¬ (S_Max_Le = {} ∧ S_Max_Lt = {})› show ?thesis by auto
qed
qed
{
fix x assume x: "x ∈ S_Min_Lt"
then have "x ≤ ?min_lt" using fin_min_lt by (simp add: max.coboundedI2)
also have "?min_lt < ?min_le"
proof (rule ccontr, goal_cases)
case 1
with x ** have 1: "?l = ?min_lt" by (auto simp: max.absorb1)
have 2: "?min_lt < ?max_le" using * ****[OF x] by auto
show False
proof (cases "S_Max_Lt = {}")
case False
then have "?min_lt < ?max_lt" using * ***[OF x] by auto
with 1 2 have "?l < ?r" by auto
with ‹¬ ?l < ?r› show False by auto
next
case True
with 1 2 have "?l < ?r" by auto
with ‹¬ ?l < ?r› show False by auto
qed
qed
finally have "x < max ?min_lt ?min_le" by (simp add: max.strict_coboundedI2)
} note 2 = this
show thesis using F False 1 2 3 4 5 6 * ** by ((intro m[of ?l]), auto)
next
case True
then obtain d where d: "?l < d" "d < ?r" using dense by auto
let ?d' = "d"
{
fix t assume "t ∈ S_Min_Le"
then have "t ≤ ?l" using 1 by auto
with d have "t ≤ d" by auto
}
moreover {
fix t assume t: "t ∈ S_Min_Lt"
then have "t ≤ max ?min_lt ?min_le" using fin_min_lt by (simp add: max.coboundedI1)
with t have "t ≤ ?l" using fin_min_lt by auto
with d have "t < d" by auto
}
moreover {
fix t assume t: "t ∈ S_Max_Le"
then have "min ?max_lt ?max_le ≤ t" using fin_max_le by (simp add: min.coboundedI2)
then have "?r ≤ t" using fin_max_le t by auto
with d have "d ≤ t" by auto
then have "d ≤ t" by (simp add: min.coboundedI2)
}
moreover {
fix t assume t: "t ∈ S_Max_Lt"
then have "min ?max_lt ?max_le ≤ t" using fin_max_lt by (simp add: min.coboundedI1)
then have "?r ≤ t" using fin_max_lt t by auto
with d have "d < t" by auto
then have "d < t" by (simp add: min.strict_coboundedI2)
}
ultimately show thesis by ((intro m[of ?d']), auto)
qed
qed
qed
qed
have "DBM_val_bounded v (u(c := d')) M n" unfolding DBM_val_bounded_def
proof (auto, goal_cases)
case 1
with A show ?case unfolding DBM_reset_def DBM_val_bounded_def by auto
next
case (2 c')
show ?case
proof (cases "c = c'")
case False
with A(2,7) have "v c ≠ v c'" by auto
hence *:"M' 0 (v c') = min (dbm_add (M 0 (v c)) (M (v c) (v c'))) (M 0 (v c'))"
using A(2,3,6,7) 2 unfolding DBM_reset_def by auto
from 2 A(2,4) have "dbm_entry_val u None (Some c') (M' 0 (v c'))"
unfolding DBM_val_bounded_def by auto
with dbm_entry_dbm_min2 * have "dbm_entry_val u None (Some c') (M 0 (v c'))" by auto
thus ?thesis using False by cases auto
next
case True
show ?thesis
proof (simp add: True[symmetric], cases "M 0 (v c)", goal_cases)
case (1 t)
hence "-t ∈ S_Min_Le" unfolding S_Min_Le by force
hence "d' ≥ -t" using d' by auto
thus ?case using 1 by (auto simp: minus_le_iff)
next
case (2 t)
hence "-t ∈ S_Min_Lt" unfolding S_Min_Lt by force
hence "d' > -t" using d' by auto
thus ?case using 2 by (auto simp: minus_less_iff)
next
case 3 thus ?case by auto
qed
qed
next
case (3 c')
show ?case
proof (cases "c = c'")
case False
with A(2,7) have "v c ≠ v c'" by auto
hence *:"M' (v c') 0 = min (dbm_add (M (v c') (v c)) (M (v c) 0)) (M (v c') 0)"
using A(2,3,6,7) 3 unfolding DBM_reset_def by auto
from 3 A(2,4) have "dbm_entry_val u (Some c') None (M' (v c') 0)"
unfolding DBM_val_bounded_def by auto
with dbm_entry_dbm_min3 * have "dbm_entry_val u (Some c') None (M (v c') 0)" by auto
thus ?thesis using False by cases auto
next
case True
show ?thesis
proof (simp add: True[symmetric], cases "M (v c) 0", goal_cases)
case (1 t)
hence "t ∈ S_Max_Le" unfolding S_Max_Le by force
hence "d' ≤ t" using d' by auto
thus ?case using 1 by (auto simp: minus_le_iff)
next
case (2 t)
hence "t ∈ S_Max_Lt" unfolding S_Max_Lt by force
hence "d' < t" using d' by auto
thus ?case using 2 by (auto simp: minus_less_iff)
next
case 3 thus ?case by auto
qed
qed
next
case (4 c1 c2)
show ?case
proof (cases "c = c1")
case False
note F1 = this
show ?thesis
proof (cases "c = c2")
case False
with A(2,6,7) F1 have "v c ≠ v c1" "v c ≠ v c2" by auto
hence *:"M' (v c1) (v c2) = min (dbm_add (M (v c1) (v c)) (M (v c) (v c2))) (M (v c1) (v c2))"
using A(2,3,6,7) 4 unfolding DBM_reset_def by auto
from 4 A(2,4) have "dbm_entry_val u (Some c1) (Some c2) (M' (v c1) (v c2))"
unfolding DBM_val_bounded_def by auto
with dbm_entry_dbm_min * have "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" by auto
thus ?thesis using F1 False by cases auto
next
case True
show ?thesis
proof (simp add: True[symmetric], cases "M (v c1) (v c)", goal_cases)
case (1 t)
hence "u c1 - t ∈ S_Min_Le" unfolding S_Min_Le using A F1 4 by blast
hence "d' ≥ u c1 - t" using d' by auto
hence "t + d' ≥ u c1" by (metis le_swap add_le_cancel_right diff_add_cancel)
hence "u c1 - d' ≤ t" by (metis add_le_imp_le_right diff_add_cancel)
thus ?case using 1 F1 by auto
next
case (2 t)
hence "u c1 - t ∈ S_Min_Lt" unfolding S_Min_Lt using A 4 F1 by blast
hence "d' > u c1 - t" using d' by auto
hence "d' + t > u c1" by (metis add_strict_right_mono diff_add_cancel)
hence "u c1 - d' < t" by (metis gt_swap add_less_cancel_right diff_add_cancel)
thus ?case using 2 F1 by auto
next
case 3 thus ?case by auto
qed
qed
next
case True
note T = this
show ?thesis
proof (cases "c = c2")
case False
show ?thesis
proof (cases "M (v c) (v c2)", goal_cases)
case (1 t)
hence "u c2 + t ∈ S_Max_Le" unfolding S_Max_Le using A 4 False by blast
hence "d' ≤ u c2 + t" using d' by auto
hence "d' - u c2 ≤ t"
by (metis (hide_lams, no_types) add_diff_cancel_left add_ac(1) add_le_cancel_right
add_right_cancel diff_add_cancel)
thus ?case using 1 T False by auto
next
case (2 t)
hence "u c2 + t ∈ S_Max_Lt" unfolding S_Max_Lt using A 4 False by blast
hence "d' < u c2 + t" using d' by auto
hence "d' - u c2 < t" by (metis gt_swap add_less_cancel_right diff_add_cancel)
thus ?case using 2 T False by force
next
case 3 thus ?case using T by auto
qed
next
case True
from A 4 have *:"dbm_entry_val u'' (Some c1) (Some c1) (M (v c1) (v c1))"
unfolding DBM_val_bounded_def by auto
show ?thesis using True T
proof (simp add: True T, cases "M (v c1) (v c1)", goal_cases)
case (1 t)
with * have "0 ≤ t" by auto
thus ?case using 1 by auto
next
case (2 t)
with * have "0 < t" by auto
thus ?case using 2 by auto
next
case 3 thus ?case by auto
qed
qed
qed
qed
thus ?thesis using A(1) by blast
qed
lemma DBM_reset_sound2:
assumes "v c ≤ n" "DBM_reset M n (v c) d M'" "DBM_val_bounded v u M' n"
shows "u c = d"
using assms unfolding DBM_val_bounded_def DBM_reset_def
by fastforce
lemma DBM_reset_sound'':
fixes M v c n d
defines "M' ≡ reset M n (v c) d"
assumes "clock_numbering' v n" "v c ≤ n" "DBM_val_bounded v u M' n"
"DBM_val_bounded v u'' M n"
obtains d' where "DBM_val_bounded v (u(c := d')) M n"
proof -
assume A:"⋀d'. DBM_val_bounded v (u(c := d')) M n ⟹ thesis"
from assms DBM_reset_reset[of "v c" n M d]
have *:"DBM_reset M n (v c) d M'" by (auto simp add: M'_def)
with DBM_reset_sound'[of v n c M d M', OF _ _ this] assms obtain d' where
"DBM_val_bounded v (u(c := d')) M n" by auto
with A show thesis by auto
qed
lemma DBM_reset_sound:
fixes M v c n d
defines "M' ≡ reset M n (v c) d"
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "v c ≤ n"
"u ∈ [M']⇘v,n⇙"
obtains d' where "u(c := d') ∈[M]⇘v,n⇙"
proof (cases "[M]⇘v,n⇙ = {}")
case False
then obtain u' where "DBM_val_bounded v u' M n" unfolding DBM_zone_repr_def by auto
from DBM_reset_sound''[OF assms(3-4) _ this] assms(1,5) that show ?thesis
unfolding DBM_zone_repr_def by auto
next
case True
with DBM_reset_complete_empty'[OF assms(2) _ _ DBM_reset_reset, of "v c" M u d] assms show ?thesis
unfolding DBM_zone_repr_def by simp
qed
lemma DBM_reset'_complete':
assumes "DBM_val_bounded v u M n" "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
shows "∃ u'. DBM_val_bounded v u' (reset' M n cs v d) n"
using assms
proof (induction cs)
case Nil thus ?case by auto
next
case (Cons c cs)
let ?M' = "reset' M n cs v d"
let ?M'' = "reset ?M' n (v c) d"
from Cons obtain u' where u': "DBM_val_bounded v u' ?M' n" by fastforce
from Cons(3,4) have "0 < v c" "v c ≤ n" by auto
from DBM_reset_reset[OF this] have **: "DBM_reset ?M' n (v c) d ?M''" by fast
from Cons(4) have "v c ≤ n" by auto
from DBM_reset_complete[of v n c ?M' d ?M'', OF Cons(3) this ** u']
have "DBM_val_bounded v (u'(c := d)) (reset (reset' M n cs v d) n (v c) d) n" by fast
thus ?case by auto
qed
lemma DBM_reset'_complete:
assumes "DBM_val_bounded v u M n" "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
shows "DBM_val_bounded v ([cs → d]u) (reset' M n cs v d) n"
using assms
proof (induction cs)
case Nil thus ?case by auto
next
case (Cons c cs)
let ?M' = "reset' M n cs v d"
let ?M'' = "reset ?M' n (v c) d"
from Cons have *: "DBM_val_bounded v ([cs→d]u) (reset' M n cs v d) n" by fastforce
from Cons(3,4) have "0 < v c" "v c ≤ n" by auto
from DBM_reset_reset[OF this] have **: "DBM_reset ?M' n (v c) d ?M''" by fast
from Cons(4) have "v c ≤ n" by auto
from DBM_reset_complete[of v n c ?M' d ?M'', OF Cons(3) this ** *]
have ***:"DBM_val_bounded v ([c#cs→d]u) (reset (reset' M n cs v d) n (v c) d) n" by simp
have "reset' M n (c#cs) v d = reset (reset' M n cs v d) n (v c) d" by auto
with *** show ?case by presburger
qed
lemma DBM_reset'_sound_empty:
assumes "clock_numbering' v n" "∀c ∈ set cs. v c ≤ n"
"∀ u . ¬ DBM_val_bounded v u (reset' M n cs v d) n"
shows "¬ DBM_val_bounded v u M n"
using assms DBM_reset'_complete by metis
fun set_clocks :: "'c list ⇒ 't::time list⇒ ('c,'t) cval ⇒ ('c,'t) cval"
where
"set_clocks [] _ u = u" |
"set_clocks _ [] u = u" |
"set_clocks (c#cs) (t#ts) u = (set_clocks cs ts (u(c:=t)))"
lemma DBM_reset'_sound':
fixes M v c n d cs
assumes "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
"DBM_val_bounded v u (reset' M n cs v d) n" "DBM_val_bounded v u'' M n"
shows "∃ts. DBM_val_bounded v (set_clocks cs ts u) M n"
using assms
proof (induction cs arbitrary: M u)
case Nil
hence "DBM_val_bounded v (set_clocks [] [] u) M n" by auto
thus ?case by blast
next
case (Cons c' cs)
let ?M' = "reset' M n (c' # cs) v d"
let ?M'' = "reset' M n cs v d"
from DBM_reset'_complete[OF Cons(5) Cons(2)] Cons(3)
have u'': "DBM_val_bounded v ([cs→d]u'') ?M'' n" by fastforce
from Cons(3,4) have "v c' ≤ n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
from DBM_reset_sound''[OF Cons(2) this u'']
obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" by blast
from Cons.IH[OF Cons.prems(1) _ ** Cons.prems(4)] Cons.prems(2)
obtain ts where ts:"DBM_val_bounded v (set_clocks cs ts (u(c' := d'))) M n" by fastforce
hence "DBM_val_bounded v (set_clocks (c' # cs) (d'#ts) u) M n" by auto
thus ?case by fast
qed
lemma DBM_reset'_resets:
fixes M v c n d cs
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
"DBM_val_bounded v u (reset' M n cs v d) n"
shows "∀c ∈ set cs. u c = d"
using assms
proof (induction cs arbitrary: M u)
case Nil thus ?case by auto
next
case (Cons c' cs)
let ?M' = "reset' M n (c' # cs) v d"
let ?M'' = "reset' M n cs v d"
from Cons(4,5) have "v c' ≤ n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
from DBM_reset_sound2[OF this(1) _ Cons(5), of ?M'' d] DBM_reset_reset[OF _ this(1), of ?M'' d] Cons(3)
have c':"u c' = d" by auto
from Cons(4,5) have "v c' ≤ n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
with DBM_reset_sound[OF Cons.prems(1,2) this(1)]
obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" unfolding DBM_zone_repr_def by blast
from Cons.IH[OF Cons.prems(1,2) _ **] Cons.prems(3) have "∀c∈set cs. (u(c' := d')) c = d" by auto
thus ?case using c'
apply safe
apply (rename_tac c)
apply (case_tac "c = c'")
by auto
qed
lemma DBM_reset'_resets':
fixes M v c n d cs
assumes "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n" "DBM_val_bounded v u (reset' M n cs v d) n"
"DBM_val_bounded v u'' M n"
shows "∀c ∈ set cs. u c = d"
using assms
proof (induction cs arbitrary: M u)
case Nil thus ?case by auto
next
case (Cons c' cs)
let ?M' = "reset' M n (c' # cs) v d"
let ?M'' = "reset' M n cs v d"
from DBM_reset'_complete[OF Cons(5) Cons(2)] Cons(3)
have u'': "DBM_val_bounded v ([cs→d]u'') ?M'' n" by fastforce
from Cons(3,4) have "v c' ≤ n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
from DBM_reset_sound2[OF this(1) _ Cons(4), of ?M'' d] DBM_reset_reset[OF _ this(1), of ?M'' d] Cons(2)
have c':"u c' = d" by auto
from Cons(3,4) have "v c' ≤ n" "DBM_val_bounded v u (reset ?M'' n (v c') d) n" by auto
from DBM_reset_sound''[OF Cons(2) this u'']
obtain d' where **:"DBM_val_bounded v (u(c' := d')) ?M'' n" by blast
from Cons.IH[OF Cons.prems(1) _ ** Cons.prems(4)] Cons.prems(2)
have "∀c∈set cs. (u(c' := d')) c = d" by auto
thus ?case using c'
apply safe
apply (rename_tac c)
apply (case_tac "c = c'")
by auto
qed
lemma DBM_reset'_neg_diag_preservation':
assumes "k≤n" "M k k < 𝟭" "clock_numbering v" "∀ c ∈ set cs. v c ≤ n"
shows "reset' M n cs v d k k < 𝟭" using assms
proof (induction cs)
case Nil thus ?case by auto
next
case (Cons c cs)
then have IH: "reset' M n cs v d k k < 𝟭" by auto
from Cons.prems have "v c > 0" "v c ≤ n" by auto
from DBM_reset_reset[OF this, of "reset' M n cs v d" d] ‹k ≤ n›
have "reset (reset' M n cs v d) n (v c) d k k ≤ reset' M n cs v d k k" unfolding DBM_reset_def
by (cases "v c = k", simp add: less[symmetric], case_tac "k = 0", auto simp: less[symmetric])
with IH show ?case by auto
qed
lemma DBM_reset'_complete_empty':
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n"
"∀ c ∈ set cs. v c ≤ n" "∀ u . ¬ DBM_val_bounded v u M n"
shows "∀ u . ¬ DBM_val_bounded v u (reset' M n cs v d) n" using assms
proof (induction cs)
case Nil then show ?case by simp
next
case (Cons c cs)
then have "∀u. ¬ DBM_val_bounded v u (reset' M n cs v d) n" by auto
from Cons.prems(2,3) DBM_reset_complete_empty'[OF Cons.prems(1) _ _ DBM_reset_reset this]
show ?case by auto
qed
lemma DBM_reset'_complete_empty:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n"
"∀ c ∈ set cs. v c ≤ n" "∀ u . ¬ DBM_val_bounded v u M n"
shows "∀ u . ¬ DBM_val_bounded v u (reset' (FW M n) n cs v d) n" using assms
proof -
note A = assms
from A(4) have "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
with FW_zone_equiv[OF A(1)] have "[FW M n]⇘v,n⇙ = {}" by auto
with FW_detects_empty_zone[OF A(1)] A(2) obtain i where i: "i ≤ n" "FW M n i i < Le 0" by blast
with DBM_reset'_neg_diag_preservation' A(2,3) have
"reset' (FW M n) n cs v d i i < Le 0"
by (auto simp: neutral)
with fw_mono[of n n n i i "reset' (FW M n) n cs v d" n] i
have "FW (reset' (FW M n) n cs v d) n i i < Le 0" by auto
with FW_detects_empty_zone[OF A(1), of "reset' (FW M n) n cs v d"] A(2,3) i
have "[FW (reset' (FW M n) n cs v d) n]⇘v,n⇙ = {}" by auto
with FW_zone_equiv[OF A(1), of "reset' (FW M n) n cs v d"] A(3,4)
show ?thesis by (auto simp: DBM_zone_repr_def)
qed
lemma DBM_reset'_empty':
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
shows "[M]⇘v,n⇙ = {} ⟷ [reset' (FW M n) n cs v d]⇘v,n⇙ = {}"
proof
let ?M' = "reset' (FW M n) n cs v d"
assume A: "[M]⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
with DBM_reset'_complete_empty[OF assms] show "[?M']⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
next
let ?M' = "reset' (FW M n) n cs v d"
assume A: "[?M']⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u ?M' n" unfolding DBM_zone_repr_def by auto
from DBM_reset'_sound_empty[OF assms(2,3) this] have "∀ u. ¬ DBM_val_bounded v u (FW M n) n" by auto
with FW_zone_equiv[OF assms(1)] show "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
qed
lemma DBM_reset'_empty:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n" "∀ c ∈ set cs. v c ≤ n"
shows "[M]⇘v,n⇙ = {} ⟷ [reset' M n cs v d]⇘v,n⇙ = {}"
proof
let ?M' = "reset' M n cs v d"
assume A: "[M]⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u M n" unfolding DBM_zone_repr_def by auto
with DBM_reset'_complete_empty'[OF assms] show "[?M']⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
next
let ?M' = "reset' M n cs v d"
assume A: "[?M']⇘v,n⇙ = {}"
hence "∀ u . ¬ DBM_val_bounded v u ?M' n" unfolding DBM_zone_repr_def by auto
from DBM_reset'_sound_empty[OF assms(2,3) this] have "∀ u. ¬ DBM_val_bounded v u M n" by auto
with FW_zone_equiv[OF assms(1)] show "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
qed
lemma DBM_reset'_sound:
assumes "∀k≤n. k > 0 ⟶ (∃c. v c = k)" "clock_numbering' v n"
and "∀c∈set cs. v c ≤ n"
and "u ∈ [reset' M n cs v d]⇘v,n⇙"
shows "∃ts. set_clocks cs ts u ∈ [M]⇘v,n⇙"
proof -
from DBM_reset'_empty[OF assms(1-3)] assms(4) obtain u' where "u' ∈ [M]⇘v,n⇙" by blast
with DBM_reset'_sound'[OF assms(2,3)] assms(4) show ?thesis unfolding DBM_zone_repr_def by blast
qed
section ‹Misc Preservation Lemmas›
lemma get_const_sum[simp]:
"a ≠ ∞ ⟹ b ≠ ∞ ⟹ get_const a ∈ ℤ ⟹ get_const b ∈ ℤ ⟹ get_const (a + b) ∈ ℤ"
by (cases a) (cases b, auto simp: mult)+
lemma sum_not_inf_dest:
assumes "a + b ≠ ∞"
shows "a ≠ ∞ ∧ b ≠ ∞"
using assms by (cases a; cases b; simp add: mult)
lemma sum_not_inf_int:
assumes "a + b ≠ ∞" "get_const a ∈ ℤ" "get_const b ∈ ℤ"
shows "get_const (a + b) ∈ ℤ"
using assms sum_not_inf_dest by fastforce
lemma int_fw_upd:
"∀ i ≤ n. ∀ j ≤ n. m i j ≠ ∞ ⟶ get_const (m i j) ∈ ℤ ⟹ k ≤ n ⟹ i ≤ n ⟹ j ≤ n
⟹ i' ≤ n ⟹ j' ≤ n ⟹ (fw_upd m k i j i' j') ≠ ∞
⟹ get_const (fw_upd m k i j i' j') ∈ ℤ"
proof (goal_cases)
case 1
show ?thesis
proof (cases "i = i' ∧ j = j'")
case True
with 1 show ?thesis by (fastforce simp: fw_upd_def upd_def min_def dest: sum_not_inf_dest)
next
case False
with 1 show ?thesis by (auto simp : fw_upd_def upd_def)
qed
qed
lemma fw_int_aux_c:
assumes "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ" "a ≤ n" "b ≤ n" "c ≤ n"
"i ≤ n" "j ≤ n" "((fw M n) 0 0 c) i j ≠ ∞"
shows "get_const (((fw M n) 0 0 c) i j) ∈ ℤ"
using assms
apply (induction c arbitrary: i j)
apply (auto simp: fw_upd_def upd_def min_def)[]
apply (case_tac "M 0 0 = ∞")
apply (simp add: mult)
apply simp
apply (fastforce simp: min_def fw_upd_def upd_def dest: sum_not_inf_dest)
done
lemma fw_int_aux_Suc_b:
assumes "∀ i ≤ n. ∀ j ≤ n. (fw M n) a b n i j ≠ ∞ ⟶ get_const ((fw M n) a b n i j) ∈ ℤ"
"a ≤ n" "Suc b ≤ n" "c ≤ n" "i ≤ n" "j ≤ n" "((fw M n) a (Suc b) c) i j ≠ ∞"
shows "get_const (((fw M n) a (Suc b) c) i j) ∈ ℤ"
using assms by (induction c arbitrary: i j) (auto intro: int_fw_upd[of n])
lemma fw_int_aux_b:
assumes "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ" "a ≤ n" "b ≤ n" "c ≤ n"
"i ≤ n" "j ≤ n" "((fw M n) 0 b c) i j ≠ ∞"
shows "get_const (((fw M n) 0 b c) i j) ∈ ℤ" using assms
apply (induction b arbitrary: i j c)
apply (blast intro: fw_int_aux_c)
apply (rule fw_int_aux_Suc_b[of n])
by auto
lemma fw_int_aux_Suc_a:
assumes "∀ i ≤ n. ∀ j ≤ n. (fw M n) a n n i j ≠ ∞ ⟶ get_const ((fw M n) a n n i j) ∈ ℤ"
"Suc a ≤ n" "b ≤ n" "c ≤ n" "i ≤ n" "j ≤ n" "((fw M n) (Suc a) b c) i j ≠ ∞"
shows "get_const (((fw M n) (Suc a) b c) i j) ∈ ℤ"
using assms
proof (induction b arbitrary: i j c)
case 0
then show ?case
by (induction c arbitrary: i j) (auto intro: int_fw_upd[of n])
next
case (Suc b)
then show ?case by (intro fw_int_aux_Suc_b) auto
qed
lemma fw_int_preservation:
assumes "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ" "a ≤ n" "b ≤ n" "c ≤ n"
"i ≤ n" "j ≤ n" "((fw M n) a b c) i j ≠ ∞"
shows "get_const (((fw M n) a b c) i j) ∈ ℤ"
using assms
apply (induction a arbitrary: i j b c)
apply (blast intro: fw_int_aux_b)
apply (rule fw_int_aux_Suc_a[of n])
by auto
lemma FW_int_preservation:
assumes "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
shows "∀ i ≤ n. ∀ j ≤ n. FW M n i j ≠ ∞ ⟶ get_const (FW M n i j) ∈ ℤ"
by (blast intro: fw_int_preservation[OF assms(1)])
abbreviation "dbm_int M n ≡ ∀ i≤n. ∀ j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
lemma And_int_preservation:
assumes "dbm_int M1 n" "dbm_int M2 n"
shows "dbm_int (And M1 M2) n"
using assms by (auto simp: min_def)
lemma up_int_preservation:
"dbm_int M n ⟹ dbm_int (up M) n"
unfolding up_def min_def
apply safe
apply (case_tac "i = 0")
apply fastforce
apply (case_tac "j = 0")
apply fastforce
apply auto
unfolding mult[symmetric] by (auto dest: sum_not_inf_dest)
lemma DBM_reset_int_preservation':
assumes "dbm_int M n" "DBM_reset M n k d M'" "d ∈ ℤ" "k ≤ n"
shows "dbm_int M' n"
proof clarify
fix i j
assume A: "i ≤ n" "j ≤ n" "M' i j ≠ ∞"
from assms(2) show "get_const (M' i j) ∈ ℤ" unfolding DBM_reset_def
apply (cases "i = k"; cases "j = k")
apply simp
using A assms(1,4) apply presburger
apply (cases "j = 0")
using assms(3) apply simp
using A apply simp
apply simp
apply (cases "i = 0")
using assms(3) apply simp
using A apply simp
using A apply simp
apply (simp split: split_min, safe)
subgoal
proof goal_cases
case 1
then have *: "M i k + M k j ≠ ∞" unfolding mult min_def by meson
with sum_not_inf_dest have "M i k ≠ ∞" "M k j ≠ ∞" by auto
with 1(3,4) assms(1,4) have "get_const (M i k) ∈ ℤ" "get_const (M k j) ∈ ℤ" by auto
with sum_not_inf_int[folded mult, OF *] show ?case unfolding mult by auto
qed
subgoal
proof goal_cases
case 1
then have *: "M i j ≠ ∞" unfolding mult min_def by meson
with 1(3,4) assms(1,4) show ?case by auto
qed
done
qed
lemma DBM_reset_int_preservation:
assumes "dbm_int M n" "d ∈ ℤ" "0 < k" "k ≤ n"
shows "dbm_int (reset M n k d) n"
using assms(3-) DBM_reset_int_preservation'[OF assms(1) DBM_reset_reset assms(2)] by blast
lemma DBM_reset'_int_preservation:
assumes "dbm_int M n" "d ∈ ℤ" "∀c. v c > 0" "∀ c ∈ set cs. v c ≤ n"
shows "dbm_int (reset' M n cs v d) n" using assms
proof (induction cs)
case Nil then show ?case by simp
next
case (Cons c cs)
from Cons.IH[OF Cons.prems(1,2,3)] Cons.prems(4) have "dbm_int (reset' M n cs v d) n" by fastforce
from DBM_reset_int_preservation[OF this Cons.prems(2), of "v c"] Cons.prems(3,4) show ?case by auto
qed
lemma int_zone_dbm:
assumes "clock_numbering' v n"
"∀ (_,d) ∈ collect_clock_pairs cc. d ∈ ℤ" "∀ c ∈ collect_clks cc. v c ≤ n"
obtains M where "{u. u ⊢ cc} = [M]⇘v,n⇙"
and "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
proof -
let ?M = "abstr cc (λi j. ∞) v"
from assms(2) have "∀ i ≤ n. ∀ j ≤ n. ?M i j ≠ ∞ ⟶ get_const (?M i j) ∈ ℤ"
by (induction cc) (auto simp: min_def)
with dbm_abstr_zone_eq[OF assms(1) assms(3)] show ?thesis by (auto intro: that)
qed
lemma reset_set1:
"∀c ∈ set cs. ([cs→d]u) c = d"
by (induction cs) auto
lemma reset_set11:
"∀c. c ∉ set cs ⟶ ([cs→d]u) c = u c"
by (induction cs) auto
lemma reset_set2:
"∀c. c ∉ set cs ⟶ (set_clocks cs ts u)c = u c"
proof (induction cs arbitrary: ts u)
case Nil then show ?case by auto
next
case Cons then show ?case
proof (cases ts, goal_cases)
case Nil then show ?thesis by simp
next
case (2 a') then show ?case by auto
qed
qed
lemma reset_set:
assumes "∀ c ∈ set cs. u c = d"
shows "[cs→d](set_clocks cs ts u) = u"
proof
fix c
show "([cs→d]set_clocks cs ts u) c = u c"
proof (cases "c ∈ set cs")
case True
hence "([cs→d]set_clocks cs ts u) c = d" using reset_set1 by fast
also have "d = u c" using assms True by auto
finally show ?thesis by auto
next
case False
hence "([cs→d]set_clocks cs ts u) c = set_clocks cs ts u c" by (simp add: reset_set11)
also with False have "… = u c" by (simp add: reset_set2)
finally show ?thesis by auto
qed
qed
abbreviation global_clock_numbering ::
"('a, 'c, 't :: time, 's) ta ⇒ ('c ⇒ nat) ⇒ nat ⇒ bool"
where
"global_clock_numbering A v n ≡
clock_numbering' v n ∧ (∀ c ∈ clk_set A. v c ≤ n) ∧ (∀k≤n. k > 0 ⟶ (∃c. v c = k))"
lemma dbm_int_abstr:
assumes "∀ (x, m) ∈ collect_clock_pairs g. m ∈ ℤ"
shows "dbm_int (abstr g (λi j. ∞) v) n"
using assms
apply (induction g)
apply auto[]
unfolding min_def by auto
lemma dbm_int_inv_abstr:
assumes "∀(x,m) ∈ clkp_set A. m ∈ ℕ"
shows "dbm_int (abstr (inv_of A l) (λi j. ∞) v) n"
proof -
from assms have "∀ (x, m) ∈ collect_clock_pairs (inv_of A l). m ∈ ℤ"
unfolding clkp_set_def collect_clki_def inv_of_def using Nats_subset_Ints by auto
from dbm_int_abstr[OF this] show ?thesis .
qed
lemma dbm_int_guard_abstr:
assumes "valid_abstraction A X k" "A ⊢ l ⟶⇗g,a,r⇖ l'"
shows "dbm_int (abstr g (λi j. ∞) v) n"
proof -
from assms have "∀(x,m) ∈ clkp_set A. m ≤ k x ∧ x ∈ X ∧ m ∈ ℕ"
by (auto elim: valid_abstraction.cases)
then have "∀ (x, m) ∈ collect_clock_pairs g. m ∈ ℤ"
unfolding clkp_set_def collect_clkt_def using assms(2) Nats_subset_Ints by fastforce
from dbm_int_abstr[OF this] show ?thesis .
qed
lemma collect_clks_id: "collect_clks cc = fst ` collect_clock_pairs cc" by (induction cc) auto
subsection ‹Unused theorems›
lemma canonical_cyc_free:
"canonical M n ⟹ ∀i ≤ n. M i i ≥ 𝟭 ⟹ cyc_free M n"
proof (rule ccontr, auto, goal_cases)
case 1
with canonical_len[OF this(1,3,3,4)] show False by auto
qed
lemma canonical_cyc_free2:
"canonical M n ⟹ cyc_free M n ⟷ (∀i ≤ n. M i i ≥ 𝟭)"
apply safe
apply (simp add: cyc_free_diag_dest')
using canonical_cyc_free by blast
lemma DBM_reset'_diag_preservation:
assumes "∀k≤n. M k k ≤ 𝟭" "clock_numbering v" "∀ c ∈ set cs. v c ≤ n"
shows "∀k≤n. reset' M n cs v d k k ≤ 𝟭" using assms
proof (induction cs)
case Nil thus ?case by auto
next
case (Cons c cs)
then have IH: "∀k≤n. reset' M n cs v d k k ≤ 𝟭" by auto
from Cons.prems have "v c > 0" "v c ≤ n" by auto
from DBM_reset_diag_preservation[of n "reset' M n cs v d", OF IH DBM_reset_reset, of "v c", OF this]
show ?case by simp
qed
end
Theory DBM_Zone_Semantics
subsection ‹Semantics Based on DBMs›
theory DBM_Zone_Semantics
imports DBM_Operations
begin
subsection ‹Single Step›
inductive step_z_dbm ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('t::time) DBM
⇒ ('c ⇒ nat) ⇒ nat ⇒ 's ⇒ ('t::time) DBM ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇘_,_⇙ ⟨_, _⟩" [61,61,61] 61)
where
step_t_z_dbm:
"D_inv = abstr (inv_of A l) (λi j. ∞) v ⟹ A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l,And (up (And D D_inv)) D_inv⟩" |
step_a_z_dbm:
"A ⊢ l ⟶⇗g,a,r⇖ l'
⟹ A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l',And (reset' (And D (abstr g (λi j. ∞) v)) n r v 0)
(abstr (inv_of A l') (λi j. ∞) v)⟩"
inductive_cases step_z_cases: "A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l', D'⟩"
declare step_z_dbm.intros[intro]
lemma step_z_dbm_preserves_int:
assumes "A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l',D'⟩" "global_clock_numbering A v n" "valid_abstraction A X k"
"dbm_int D n"
shows "dbm_int D' n"
using assms
proof (cases, goal_cases)
case (1 D'')
hence "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" by blast+
from 1(2) have "∀ (x, m) ∈ clkp_set A. m ∈ ℕ" by (auto elim: valid_abstraction.cases)
from dbm_int_inv_abstr[OF this] 1 have D''_int: "dbm_int D'' n" by simp
show ?thesis unfolding 1(5) by (intro And_int_preservation up_int_preservation dbm_int_inv_abstr D''_int 1)
next
case (2 g a r)
hence assms: "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" "∀k≤n. k > 0 ⟶ (∃c. v c = k)" by blast+
from 2(2) have *: "∀ (x, m) ∈ clkp_set A. m ∈ ℕ" by (auto elim: valid_abstraction.cases)
from dbm_int_inv_abstr[OF this] have D'_int: "dbm_int (abstr (inv_of A l') (λi j. ∞) v) n" by simp
from dbm_int_guard_abstr 2 have D''_int: "dbm_int (abstr g (λi j. ∞) v) n" by simp
have "set r ⊆ clk_set A" using 2(5) unfolding trans_of_def collect_clkvt_def by fastforce
hence **:"∀c∈set r. v c ≤ n" using assms(2) by fastforce
show ?thesis unfolding 2(4)
by (intro And_int_preservation DBM_reset'_int_preservation dbm_int_inv_abstr 2 D''_int)
(simp_all add: assms(1) * **)
qed
lemma And_correct:
shows "[M1]⇘v,n⇙ ∩ [M2]⇘v,n⇙ = [And M1 M2]⇘v,n⇙"
using DBM_and_sound1 DBM_and_sound2 DBM_and_complete unfolding DBM_zone_repr_def by auto
lemma up_correct:
assumes "clock_numbering' v n"
shows "[up M]⇘v,n⇙ = [M]⇘v,n⇙⇧↑"
using assms
apply safe
apply (rule DBM_up_sound')
apply assumption+
apply (rule DBM_up_complete')
apply auto
done
lemma step_z_dbm_sound:
assumes "A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l', D'⟩" "global_clock_numbering A v n"
shows "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l', [D']⇘v,n⇙⟩"
using assms
proof (cases, goal_cases)
case (1 D'')
hence "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" by blast+
note assms = assms(1) this
from assms(3) have *: "∀c∈collect_clks (inv_of A l). v c ≤ n"
unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
from 1 have D'':"[D'']⇘v,n⇙ = {u. u ⊢ inv_of A l}" using dbm_abstr_zone_eq[OF assms(2) *] by metis
with And_correct have A11: "[And D D'']⇘v,n⇙ = ([D]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l})" by blast
with And_correct D'' have
"[D']⇘v,n⇙ = ([up (And D D'')]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l})"
unfolding 1(3) by blast
with up_correct[OF assms(2)] A11 have
"[D']⇘v,n⇙ = (([D]⇘v,n⇙) ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
by metis
with 1(2) show ?thesis by auto
next
case (2 g a r)
hence "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" "∀k≤n. k > 0 ⟶ (∃c. v c = k)" by blast+
note assms = assms(1) this
from assms(3) have *: "∀c∈collect_clks (inv_of A l'). v c ≤ n"
unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
have D':
"[abstr (inv_of A l') (λi j. ∞) v]⇘v,n⇙ = {u. u ⊢ inv_of A l'}"
using 2 dbm_abstr_zone_eq[OF assms(2) *] by simp
from assms(3) 2(3) have *: "∀c∈collect_clks g. v c ≤ n"
unfolding clkp_set_def collect_clkt_def inv_of_def by (fastforce simp: collect_clks_id)
have D'':"[abstr g (λi j. ∞) v]⇘v,n⇙ = {u. u ⊢ g}" using 2 dbm_abstr_zone_eq[OF assms(2) *] by auto
with And_correct have A11: "[And D (abstr g (λi j. ∞) v)]⇘v,n⇙ = ([D]⇘v,n⇙) ∩ ({u. u ⊢ g})" by blast
let ?D = "reset' (And D (abstr g (λi j. ∞) v)) n r v 0"
have "set r ⊆ clk_set A" using 2(3) unfolding trans_of_def collect_clkvt_def by fastforce
hence **:"∀c∈set r. v c ≤ n" using assms(3) by fastforce
have D_reset: "[?D]⇘v,n⇙ = zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r"
proof safe
fix u assume u: "u ∈ [?D]⇘v,n⇙"
from DBM_reset'_sound[OF assms(4,2) ** this] obtain ts where
"set_clocks r ts u ∈ [And D (abstr g (λi j. ∞) v)]⇘v,n⇙"
by auto
with A11 have *: "set_clocks r ts u ∈ ([D]⇘v,n⇙) ∩ ({u. u ⊢ g})" by blast
from DBM_reset'_resets[OF assms(4,2) **] u
have "∀c ∈ set r. u c = 0" unfolding DBM_zone_repr_def by auto
from reset_set[OF this] have "[r→0]set_clocks r ts u = u" by simp
with * show "u ∈ zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r" unfolding zone_set_def by force
next
fix u assume u: "u ∈ zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r"
from DBM_reset'_complete[OF _ assms(2) **] u A11
show "u ∈ [?D]⇘v,n⇙" unfolding DBM_zone_repr_def zone_set_def by force
qed
from D' And_correct D_reset have A22:
"[And ?D (abstr (inv_of A l') (λi j. ∞) v)]⇘v,n⇙ = ([?D]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l'})"
by blast
with D_reset 2(2,3) show ?thesis by auto
qed
lemma step_z_dbm_DBM:
assumes "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l', Z⟩" "global_clock_numbering A v n"
obtains D' where "A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l', D'⟩" "Z = [D']⇘v,n⇙"
using assms
proof (cases, goal_cases)
case 1
hence "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" by metis+
note assms = assms(1) this
from assms(3) have *: "∀c∈collect_clks (inv_of A l). v c ≤ n"
unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
obtain D'' where D''_def: "D'' = abstr (inv_of A l) (λi j. ∞) v" by auto
hence D'':"[D'']⇘v,n⇙ = {u. u ⊢ inv_of A l}" using dbm_abstr_zone_eq[OF assms(2) *] by metis
obtain A1 where A1: "A1 = And D D''" by fast
with And_correct D'' have A11: "[A1]⇘v,n⇙ = ([D]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l})" by blast
then obtain D_up where D_up': "D_up = up A1" by blast
with up_correct assms(2) A11 have D_up: "[D_up]⇘v,n⇙ = (([D]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l}))⇧↑" by metis
obtain A2 where A2: "A2 = And D_up D''" by fast
with And_correct D'' have A22: "[A2]⇘v,n⇙ = ([D_up]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l})" by blast
from A2 D_up' D''_def A1 have "A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l,A2⟩" by blast
moreover from A22 D_up have
"[A2]⇘v,n⇙ = (([D]⇘v,n⇙) ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
by auto
ultimately show thesis using 1 by (intro that[of A2]) auto
next
case (2 g a r)
hence "clock_numbering' v n" "∀c∈clk_set A. v c ≤ n" "∀k≤n. k > 0 ⟶ (∃c. v c = k)" by metis+
note assms = assms(1) this
from assms(3) have *: "∀c∈collect_clks (inv_of A l'). v c ≤ n"
unfolding clkp_set_def collect_clki_def inv_of_def by (fastforce simp: collect_clks_id)
obtain D' where D'_def: "D' = abstr (inv_of A l') (λi j. ∞) v" by blast
hence D':"[D']⇘v,n⇙ = {u. u ⊢ inv_of A l'}" using dbm_abstr_zone_eq[OF assms(2) *] by simp
from assms(3) 2(4) have *: "∀c∈collect_clks g. v c ≤ n"
unfolding clkp_set_def collect_clkt_def inv_of_def by (fastforce simp: collect_clks_id)
obtain D'' where D''_def: "D'' = abstr g (λi j. ∞) v" by blast
hence D'':"[D'']⇘v,n⇙ = {u. u ⊢ g}" using dbm_abstr_zone_eq[OF assms(2) *] by auto
obtain A1 where A1: "A1 = And D D''" by fast
with And_correct D'' have A11: "[A1]⇘v,n⇙ = ([D]⇘v,n⇙) ∩ ({u. u ⊢ g})" by blast
let ?D = "reset' A1 n r v 0"
have "set r ⊆ clk_set A" using 2(4) unfolding trans_of_def collect_clkvt_def by fastforce
hence **:"∀c∈set r. v c ≤ n" using assms(3) by fastforce
have D_reset: "[?D]⇘v,n⇙ = zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r"
proof safe
fix u assume u: "u ∈ [?D]⇘v,n⇙"
from DBM_reset'_sound[OF assms(4,2) ** this] obtain ts where
"set_clocks r ts u ∈ [A1]⇘v,n⇙"
by auto
with A11 have *: "set_clocks r ts u ∈ ([D]⇘v,n⇙) ∩ ({u. u ⊢ g})" by blast
from DBM_reset'_resets[OF assms(4,2) **] u
have "∀c ∈ set r. u c = 0" unfolding DBM_zone_repr_def by auto
from reset_set[OF this] have "[r→0]set_clocks r ts u = u" by simp
with * show "u ∈ zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r" unfolding zone_set_def by force
next
fix u assume u: "u ∈ zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r"
from DBM_reset'_complete[OF _ assms(2) **] u A11
show "u ∈ [?D]⇘v,n⇙" unfolding DBM_zone_repr_def zone_set_def by force
qed
obtain A2 where A2: "A2 = And ?D D'" by fast
with And_correct D' have A22: "[A2]⇘v,n⇙ = ([?D]⇘v,n⇙) ∩ ({u. u ⊢ inv_of A l'})" by blast
from 2(4) A2 D'_def D''_def A1 have "A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l',A2⟩" by blast
moreover from A22 D_reset have
"[A2]⇘v,n⇙ = zone_set (([D]⇘v,n⇙) ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
by auto
ultimately show ?thesis using 2 by (intro that[of A2]) simp+
qed
lemma step_z_computable:
assumes "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l',Z⟩" "global_clock_numbering A v n"
obtains D' where "Z = [D']⇘v,n⇙"
using step_z_dbm_DBM[OF assms] by blast
lemma step_z_dbm_complete:
assumes "global_clock_numbering A v n" "A ⊢ ⟨l, u⟩ → ⟨l',u'⟩"
and "u ∈ [(D )]⇘v,n⇙"
shows "∃ D'. A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l',D'⟩ ∧ u' ∈ [D']⇘v,n⇙"
proof -
note A = assms
from step_z_complete[OF A(2,3)] obtain Z' where Z': "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l',Z'⟩" "u' ∈ Z'" by auto
with step_z_dbm_DBM[OF Z'(1) A(1)] obtain D' where D':
"A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l',D'⟩" "Z' = [D']⇘v,n⇙"
by metis
with Z'(2) show ?thesis by auto
qed
subsection ‹Multi Step›
inductive steps_z_dbm ::
"('a, 'c, 't, 's) ta ⇒ 's ⇒ ('t::time) DBM
⇒ ('c ⇒ nat) ⇒ nat ⇒ 's ⇒ ('t::time) DBM ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝*⇘_,_⇙ ⟨_, _⟩" [61,61,61] 61)
where
refl: "A ⊢ ⟨l,D⟩ ↝*⇘v,n⇙ ⟨l,D⟩" |
step: "A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l',D'⟩ ⟹ A ⊢ ⟨l',D'⟩ ↝*⇘v,n⇙ ⟨l'',D''⟩ ⟹
A ⊢ ⟨l,D⟩ ↝*⇘v,n⇙ ⟨l'',D''⟩"
declare steps_z_dbm.intros[intro]
lemma steps_z_dbm_sound:
assumes "A ⊢ ⟨l,D⟩ ↝*⇘v,n⇙ ⟨l',D'⟩"
and "global_clock_numbering A v n"
and "u' ∈ [D']⇘v,n⇙"
shows "∃ u ∈ [D]⇘v,n⇙. A ⊢ ⟨l, u⟩ →* ⟨l',u'⟩" using assms
proof (induction A l D v n l' D' rule: steps_z_dbm.induct)
case refl thus ?case by fast
next
case (step A l D v n l' D' l'' D'')
then obtain u'' where u'': "A ⊢ ⟨l', u''⟩ →* ⟨l'',u'⟩" "u''∈[D']⇘v,n⇙" by blast
with step_z_sound[OF step_z_dbm_sound[OF step(1,4)]] obtain u where
"u ∈ [D]⇘v,n⇙" "A ⊢ ⟨l, u⟩ → ⟨l',u''⟩"
by blast
with u'' show ?case by blast
qed
lemma steps_z_dbm_complete:
assumes "A ⊢ ⟨l, u⟩ →* ⟨l',u'⟩"
and "global_clock_numbering A v n"
and "u ∈ [D]⇘v,n⇙"
shows "∃ D'. A ⊢ ⟨l, D⟩ ↝*⇘v,n⇙ ⟨l', D'⟩ ∧ u' ∈ [D']⇘v,n⇙" using assms
proof (induction arbitrary: D rule: steps.induct)
case refl thus ?case by auto
next
case (step A l u l' u' l'' u'' D)
from step_z_dbm_complete[OF step(4,1,5)] obtain D'
where D': "A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l',D'⟩" "u' ∈ [D']⇘v,n⇙" by auto
with step(3)[OF step(4)] obtain D'' where
"A ⊢ ⟨l',D'⟩ ↝*⇘v,n⇙ ⟨l'',D''⟩" "u'' ∈ [D'']⇘v,n⇙"
by blast
with D' show ?case by blast
qed
end
Theory Misc
theory Misc
imports Complex_Main
begin
chapter ‹Basic lemmas which do not belong to the particular domain of Timed Automata›
section ‹Reals›
subsection ‹Properties of fractions›
lemma frac_add_le_preservation:
fixes a d :: real and b :: nat
assumes "a < b" "d < 1 - frac a"
shows "a + d < b"
proof -
from assms have "a + d < a + 1 - frac a" by auto
also have "… = (a - frac a) + 1" by auto
also have "… = floor a + 1" unfolding frac_def by auto
also have "… ≤ b" using ‹a < b›
by (metis floor_less_iff int_less_real_le of_int_1 of_int_add of_int_of_nat_eq)
finally show "a + d < b" .
qed
lemma lt_lt_1_ccontr:
"(a :: int) < b ⟹ b < a + 1 ⟹ False" by auto
lemma int_intv_frac_gt0:
"(a :: int) < b ⟹ b < a + 1 ⟹ frac b > 0" by auto
lemma floor_frac_add_preservation:
fixes a d :: real
assumes "0 < d" "d < 1 - frac a"
shows "floor a = floor (a + d)"
proof -
have "frac a ≥ 0" by auto
with assms(2) have "d < 1" by linarith
from assms have "a + d < a + 1 - frac a" by auto
also have "… = (a - frac a) + 1" by auto
also have "… = (floor a) + 1" unfolding frac_def by auto
finally have *: "a + d < floor a + 1" .
have "floor (a + d) ≥ floor a" using ‹d > 0› by linarith
moreover from * have "floor (a + d) < floor a + 1" by linarith
ultimately show "floor a = floor (a + d)" by auto
qed
lemma frac_distr:
fixes a d :: real
assumes "0 < d" "d < 1 - frac a"
shows "frac (a + d) > 0" "frac a + d = frac (a + d)"
proof -
have "frac a ≥ 0" by auto
with assms(2) have "d < 1" by linarith
from assms have "a + d < a + 1 - frac a" by auto
also have "… = (a - frac a) + 1" by auto
also have "… = (floor a) + 1" unfolding frac_def by auto
finally have *: "a + d < floor a + 1" .
have **: "floor a < a + d" using assms(1) by linarith
have "frac (a + d) ≠ 0"
proof (rule ccontr, auto, goal_cases)
case 1
then obtain b :: int where "b = a + d" by (metis Ints_cases)
with * ** have "b < floor a + 1" "floor a < b" by auto
with lt_lt_1_ccontr show ?case by blast
qed
then show "frac (a + d) > 0" by auto
from floor_frac_add_preservation assms have "floor a = floor (a + d)" by auto
then show "frac a + d = frac (a + d)" unfolding frac_def by force
qed
lemma frac_add_leD:
fixes a d :: real
assumes "0 < d" "d < 1 - frac a" "d < 1 - frac b" "frac (a + d) ≤ frac (b + d)"
shows "frac a ≤ frac b"
proof -
from floor_frac_add_preservation assms have
"floor a = floor (a + d)" "floor b = floor (b + d)"
by auto
with assms(4) show "frac a ≤ frac b" unfolding frac_def by auto
qed
lemma floor_frac_add_preservation':
fixes a d :: real
assumes "0 ≤ d" "d < 1 - frac a"
shows "floor a = floor (a + d)"
using assms floor_frac_add_preservation by (cases "d = 0") auto
lemma frac_add_leIFF:
fixes a d :: real
assumes "0 ≤ d" "d < 1 - frac a" "d < 1 - frac b"
shows "frac a ≤ frac b ⟷ frac (a + d) ≤ frac (b + d)"
proof -
from floor_frac_add_preservation' assms have
"floor a = floor (a + d)" "floor b = floor (b + d)"
by auto
then show ?thesis unfolding frac_def by auto
qed
lemma nat_intv_frac_gt0:
fixes c :: nat fixes x :: real
assumes "c < x" "x < real (c + 1)"
shows "frac x > 0"
proof (rule ccontr, auto, goal_cases)
case 1
then obtain d :: int where d: "x = d" by (metis Ints_cases)
with assms have "c < d" "d < int c + 1" by auto
with int_intv_frac_gt0[OF this] 1 d show False by auto
qed
lemma nat_intv_frac_decomp:
fixes c :: nat and d :: real
assumes "c < d" "d < c + 1"
shows "d = c + frac d"
proof -
from assms have "int c = ⌊d⌋" by linarith
thus ?thesis by (simp add: frac_def)
qed
lemma nat_intv_not_int:
fixes c :: nat
assumes "real c < d" "d < c + 1"
shows "d ∉ ℤ"
proof (standard, goal_cases)
case 1
then obtain k :: int where "d = k" using Ints_cases by auto
then have "frac d = 0" by auto
moreover from nat_intv_frac_decomp[OF assms] have *: "d = c + frac d" by auto
ultimately have "d = c" by linarith
with assms show ?case by auto
qed
lemma frac_idempotent: "frac (frac x) = frac x" by (simp add: frac_eq frac_lt_1)
lemma frac_nat_add_id: "frac ((n :: nat) + (r :: real)) = frac r"
proof -
have "⋀r. frac (r::real) < 1"
by (meson frac_lt_1)
then show ?thesis
by (simp add: floor_add frac_def)
qed
lemma floor_nat_add_id: "0 ≤ (r :: real) ⟹ r < 1 ⟹ floor (real (n::nat) + r) = n" by linarith
lemma int_intv_frac_gt_0':
"(a :: real) ∈ ℤ ⟹ (b :: real) ∈ ℤ ⟹ a ≤ b ⟹ a ≠ b ⟹ a ≤ b - 1"
proof (goal_cases)
case 1
then have "a < b" by auto
from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
with ‹a < b› show ?case by auto
qed
lemma int_lt_Suc_le:
"(a :: real) ∈ ℤ ⟹ (b :: real) ∈ ℤ ⟹ a < b + 1 ⟹ a ≤ b"
proof (goal_cases)
case 1
from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
with ‹a < b + 1› show ?case by auto
qed
lemma int_lt_neq_Suc_lt:
"(a :: real) ∈ ℤ ⟹ (b :: real) ∈ ℤ ⟹ a < b ⟹ a + 1 ≠ b ⟹ a + 1 < b"
proof (goal_cases)
case 1
from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
with 1 show ?case by auto
qed
lemma int_lt_neq_prev_lt:
"(a :: real) ∈ ℤ ⟹ (b :: real) ∈ ℤ ⟹ a - 1 < b ⟹ a ≠ b ⟹ a < b"
proof (goal_cases)
case 1
from 1(1,2) obtain k l :: int where "a = real_of_int k" "b = real_of_int l" by (metis Ints_cases)
with 1 show ?case by auto
qed
lemma ints_le_add_frac1:
fixes a b x :: real
assumes "0 < x" "x < 1" "a ∈ ℤ" "b ∈ ℤ" "a + x ≤ b"
shows "a ≤ b"
using assms by auto
lemma ints_le_add_frac2:
fixes a b x :: real
assumes "0 ≤ x" "x < 1" "a ∈ ℤ" "b ∈ ℤ" "b ≤ a + x"
shows "b ≤ a"
using assms
by (metis add.commute add_le_cancel_left add_mono_thms_linordered_semiring(1) int_lt_Suc_le leD le_less_linear)
section ‹Ordering Fractions›
lemma distinct_twice_contradiction:
"xs ! i = x ⟹ xs ! j = x ⟹ i < j ⟹ j < length xs ⟹ ¬ distinct xs"
proof (rule ccontr, simp, induction xs arbitrary: i j)
case Nil thus ?case by auto
next
case (Cons y xs)
show ?case
proof (cases "i = 0")
case True
with Cons have "y = x" by auto
moreover from True Cons have "x ∈ set xs" by auto
ultimately show False using Cons(6) by auto
next
case False
with Cons have
"xs ! (i - 1) = x" "xs ! (j - 1) = x" "i - 1 < j - 1" "j - 1 < length xs" "distinct xs"
by auto
from Cons.IH[OF this] show False .
qed
qed
lemma distinct_nth_unique:
"xs ! i = xs ! j ⟹ i < length xs ⟹ j < length xs ⟹ distinct xs ⟹ i = j"
apply (rule ccontr)
apply (cases "i < j")
apply auto
apply (auto dest: distinct_twice_contradiction)
using distinct_twice_contradiction by fastforce
lemma (in linorder) linorder_order_fun:
fixes S :: "'a set"
assumes "finite S"
obtains f :: "'a ⇒ nat"
where "(∀ x ∈ S. ∀ y ∈ S. f x ≤ f y ⟷ x ≤ y)" and "range f ⊆ {0..card S - 1}"
proof -
obtain l where l_def: "l = sorted_list_of_set S" by auto
with assms have l: "set l = S" "sorted l" "distinct l" by auto
from l(1,3) ‹finite S› have len: "length l = card S" using distinct_card by force
let ?f = "λ x. if x ∉ S then 0 else THE i. i < length l ∧ l ! i = x"
{ fix x y assume A: "x ∈ S" "y ∈ S" "x < y"
with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
by (meson in_set_conv_nth)
have "i < j"
proof (rule ccontr, goal_cases)
case 1
with sorted_nth_mono[OF l(2)] ‹i < length l› have "l ! j ≤ l ! i" by auto
with * A(3) show False by auto
qed
moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
ultimately have "?f x < ?f y" by auto
} moreover
{ fix x y assume A: "x ∈ S" "y ∈ S" "?f x < ?f y"
with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
by (meson in_set_conv_nth)
moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
ultimately have **: "l ! ?f x = x" "l ! ?f y = y" "i < j" using A(3) by auto
have "x < y"
proof (rule ccontr, goal_cases)
case 1
then have "y ≤ x" by simp
moreover from sorted_nth_mono[OF l(2), of i j] **(3) * have "x ≤ y" by auto
ultimately show False using distinct_nth_unique[OF _ *(3,4) l(3)] *(1,2) **(3) by fastforce
qed
}
ultimately have "∀ x ∈ S. ∀ y ∈ S. ?f x ≤ ?f y ⟷ x ≤ y" by force
moreover have "range ?f ⊆ {0..card S - 1}"
proof (auto, goal_cases)
case (1 x)
with l(1) obtain i where *: "l ! i = x" "i < length l" by (meson in_set_conv_nth)
then have "?f x = i" using l(3) 1 by (auto) (rule, auto intro: distinct_nth_unique)
with len show ?case using *(2) 1 by auto
qed
ultimately show ?thesis ..
qed
locale enumerateable =
fixes T :: "'a set"
fixes less :: "'a ⇒ 'a ⇒ bool" (infix "≺" 50)
assumes finite: "finite T"
assumes total: "∀ x ∈ T. ∀ y ∈ T. x ≠ y ⟶ (x ≺ y) ∨ (y ≺ x)"
assumes trans: "∀x ∈ T. ∀ y ∈ T. ∀ z ∈ T. (x :: 'a) ≺ y ⟶ y ≺ z ⟶ x ≺ z"
assumes asymmetric: "∀ x ∈ T. ∀ y ∈ T. x ≺ y ⟶ ¬ (y ≺ x)"
begin
lemma non_empty_set_has_least':
"S ⊆ T ⟹ S ≠ {} ⟹ ∃ x ∈ S. ∀ y ∈ S. x ≠ y ⟶ ¬ y ≺ x"
proof (rule ccontr, induction "card S" arbitrary: S)
case 0 then show ?case using finite by (auto simp: finite_subset)
next
case (Suc n)
then obtain x where x: "x ∈ S" by blast
from finite Suc.prems(1) have finite: "finite S" by (auto simp: finite_subset)
let ?S = "S - {x}"
show ?case
proof (cases "S = {x}")
case True
with Suc.prems(3) show False by auto
next
case False
then have S: "?S ≠ {}" using x by blast
show False
proof (cases "∃x ∈ ?S. ∀y∈?S. x ≠ y ⟶ ¬ y ≺ x")
case False
have "n = card ?S" using Suc.hyps finite by (simp add: x)
from Suc.hyps(1)[OF this _ S False] Suc.prems(1) show False by auto
next
case True
then obtain x' where x': "∀y∈?S. x' ≠ y ⟶ ¬ y ≺ x'" "x' ∈ ?S" "x ≠ x'" by auto
from total Suc.prems(1) x'(2) have "⋀ y. y ∈ S ⟹ x' ≠ y ⟹ ¬ y ≺ x' ⟹ x' ≺ y" by auto
from total Suc.prems(1) x'(1,2) have *: "∀ y ∈ ?S. x' ≠ y ⟶ x' ≺ y" by auto
from Suc.prems(3) x'(1,2) have **: "x ≺ x'" by auto
have "∀ y ∈ ?S. x ≺ y"
proof
fix y assume y: "y ∈ S - {x}"
show "x ≺ y"
proof (cases "y = x'")
case True then show ?thesis using ** by simp
next
case False
with * y have "x' ≺ y" by auto
with trans Suc.prems(1) ** y x'(2) x ** show ?thesis by auto
qed
qed
with x Suc.prems(1,3) show False using asymmetric by blast
qed
qed
qed
lemma non_empty_set_has_least'':
"S ⊆ T ⟹ S ≠ {} ⟹ ∃! x ∈ S. ∀ y ∈ S. x ≠ y ⟶ ¬ y ≺ x"
proof (intro ex_ex1I, goal_cases)
case 1
with non_empty_set_has_least'[OF this] show ?case by auto
next
case (2 x y)
show ?case
proof (rule ccontr)
assume "x ≠ y"
with 2 total have "x ≺ y ∨ y ≺ x" by blast
with 2(2-) ‹x ≠ y› show False by auto
qed
qed
abbreviation "least S ≡ THE t :: 'a. t ∈ S ∧ (∀ y ∈ S. t ≠ y ⟶ ¬ y ≺ t)"
lemma non_empty_set_has_least:
"S ⊆ T ⟹ S ≠ {} ⟹ least S ∈ S ∧ (∀ y ∈ S. least S ≠ y ⟶ ¬ y ≺ least S)"
proof goal_cases
case 1
note A = this
show ?thesis
proof (rule theI', goal_cases)
case 1
from non_empty_set_has_least''[OF A] show ?case .
qed
qed
fun f :: "'a set ⇒ nat ⇒ 'a list"
where
"f S 0 = []" |
"f S (Suc n) = least S # f (S - {least S}) n"
inductive sorted :: "'a list ⇒ bool" where
Nil [iff]: "sorted []"
| Cons: "∀y∈set xs. x ≺ y ⟹ sorted xs ⟹ sorted (x # xs)"
lemma f_set:
"S ⊆ T ⟹ n = card S ⟹ set (f S n) = S"
proof (induction n arbitrary: S)
case 0 then show ?case using finite by (auto simp: finite_subset)
next
case (Suc n)
then have fin: "finite S" using finite by (auto simp: finite_subset)
with Suc.prems have "S ≠ {}" by auto
from non_empty_set_has_least[OF Suc.prems(1) this] have least: "least S ∈ S" by blast
let ?S = "S - {least S}"
from fin least Suc.prems have "?S ⊆ T" "n = card ?S" by auto
from Suc.IH[OF this] have "set (f ?S n) = ?S" .
with least show ?case by auto
qed
lemma f_distinct:
"S ⊆ T ⟹ n = card S ⟹ distinct (f S n)"
proof (induction n arbitrary: S)
case 0 then show ?case using finite by (auto simp: finite_subset)
next
case (Suc n)
then have fin: "finite S" using finite by (auto simp: finite_subset)
with Suc.prems have "S ≠ {}" by auto
from non_empty_set_has_least[OF Suc.prems(1) this] have least: "least S ∈ S" by blast
let ?S = "S - {least S}"
from fin least Suc.prems have "?S ⊆ T" "n = card ?S" by auto
from Suc.IH[OF this] f_set[OF this] have "distinct (f ?S n)" "set (f ?S n) = ?S" .
then show ?case by simp
qed
lemma f_sorted:
"S ⊆ T ⟹ n = card S ⟹ sorted (f S n)"
proof (induction n arbitrary: S)
case 0 then show ?case by auto
next
case (Suc n)
then have fin: "finite S" using finite by (auto simp: finite_subset)
with Suc.prems have "S ≠ {}" by auto
from non_empty_set_has_least[OF Suc.prems(1) this] have least:
"least S ∈ S" "(∀ y ∈ S. least S ≠ y ⟶ ¬ y ≺ least S)"
by blast+
let ?S = "S - {least S}"
{ fix x assume x: "x ∈ ?S"
with least have "¬ x ≺ least S" by auto
with total x Suc.prems(1) least(1) have "least S ≺ x" by blast
} note le = this
from fin least Suc.prems have "?S ⊆ T" "n = card ?S" by auto
from f_set[OF this] Suc.IH[OF this] have *: "set (f ?S n) = ?S" "sorted (f ?S n)" .
with le have "∀ x ∈ set (f ?S n). least S ≺ x" by auto
with *(2) show ?case by (auto intro: Cons)
qed
lemma sorted_nth_mono:
"sorted xs ⟹ i < j ⟹ j < length xs ⟹ xs!i ≺ xs!j"
proof (induction xs arbitrary: i j)
case Nil thus ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "i = 0")
case True
with Cons.prems show ?thesis by (auto elim: sorted.cases)
next
case False
from Cons.prems have "sorted xs" by (auto elim: sorted.cases)
from Cons.IH[OF this] Cons.prems False show ?thesis by auto
qed
qed
lemma order_fun:
fixes S :: "'a set"
assumes "S ⊆ T"
obtains f :: "'a ⇒ nat" where "∀ x ∈ S. ∀ y ∈ S. f x < f y ⟷ x ≺ y" and "range f ⊆ {0..card S - 1}"
proof -
obtain l where l_def: "l = f S (card S)" by auto
with f_set f_distinct f_sorted assms have l: "set l = S" "sorted l" "distinct l" by auto
then have len: "length l = card S" using distinct_card by force
let ?f = "λ x. if x ∉ S then 0 else THE i. i < length l ∧ l ! i = x"
{ fix x y :: 'a assume A: "x ∈ S" "y ∈ S" "x ≺ y"
with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
by (meson in_set_conv_nth)
have "i ≠ j"
proof (rule ccontr, goal_cases)
case 1
with A * have "x ≺ x" by auto
with asymmetric A assms show False by auto
qed
have "i < j"
proof (rule ccontr, goal_cases)
case 1
with ‹i ≠ j› sorted_nth_mono[OF l(2)] ‹i < length l› have "l ! j ≺ l ! i" by auto
with * A(3) A assms asymmetric show False by auto
qed
moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
ultimately have "?f x < ?f y" by auto
} moreover
{ fix x y assume A: "x ∈ S" "y ∈ S" "?f x < ?f y"
with l(1) obtain i j where *: "l ! i = x" "l ! j = y" "i < length l" "j < length l"
by (meson in_set_conv_nth)
moreover have "?f x = i" using * l(3) A(1) by (auto) (rule, auto intro: distinct_nth_unique)
moreover have "?f y = j" using * l(3) A(2) by (auto) (rule, auto intro: distinct_nth_unique)
ultimately have **: "l ! ?f x = x" "l ! ?f y = y" "i < j" using A(3) by auto
from sorted_nth_mono[OF l(2), of i j] **(3) * have "x ≺ y" by auto
}
ultimately have "∀ x ∈ S. ∀ y ∈ S. ?f x < ?f y ⟷ x ≺ y" by force
moreover have "range ?f ⊆ {0..card S - 1}"
proof (auto, goal_cases)
case (1 x)
with l(1) obtain i where *: "l ! i = x" "i < length l" by (meson in_set_conv_nth)
then have "?f x = i" using l(3) 1 by (auto) (rule, auto intro: distinct_nth_unique)
with len show ?case using *(2) 1 by auto
qed
ultimately show ?thesis ..
qed
end
lemma finite_total_preorder_enumeration:
fixes X :: "'a set"
fixes r :: "'a rel"
assumes fin: "finite X"
assumes tot: "total_on X r"
assumes refl: "refl_on X r"
assumes trans: "trans r"
obtains f :: "'a ⇒ nat" where "∀ x ∈ X. ∀ y ∈ X. f x ≤ f y ⟷ (x, y) ∈ r"
proof -
let ?A = "λ x. {y ∈ X . (y, x) ∈ r ∧ (x, y) ∈ r}"
have ex: "∀ x ∈ X. x ∈ ?A x" using refl unfolding refl_on_def by auto
let ?R = "λ S. SOME y. y ∈ S"
let ?T = "{?A x | x. x ∈ X}"
{ fix A assume A: "A ∈ ?T"
then obtain x where x: "x ∈ X" "?A x = A" by auto
then have "x ∈ A" using refl unfolding refl_on_def by auto
then have "?R A ∈ A" by (auto intro: someI)
with x(2) have "(?R A, x) ∈ r" "(x, ?R A) ∈ r" by auto
with trans have "(?R A, ?R A) ∈ r" unfolding trans_def by blast
} note refl_lifted = this
{ fix A assume A: "A ∈ ?T"
then obtain x where x: "x ∈ X" "?A x = A" by auto
then have "x ∈ A" using refl unfolding refl_on_def by auto
then have "?R A ∈ A" by (auto intro: someI)
} note R_in = this
{ fix A y z assume A: "A ∈ ?T" and y: "y ∈ A" and z: "z ∈ A"
from A obtain x where x: "x ∈ X" "?A x = A" by auto
then have "x ∈ A" using refl unfolding refl_on_def by auto
with x y have "(x, y) ∈ r" "(y, x) ∈ r" by auto
moreover from x z have "(x,z) ∈ r" "(z,x) ∈ r" by auto
ultimately have "(y, z) ∈ r" "(z, y) ∈ r" using trans unfolding trans_def by blast+
} note A_dest' = this
{ fix A y assume "A ∈ ?T" and "y ∈ A"
with A_dest'[OF _ _ R_in] have "(?R A, y) ∈ r" "(y, ?R A) ∈ r" by blast+
} note A_dest = this
{ fix A y z assume A: "A ∈ ?T" and y: "y ∈ A" and z: "z ∈ X" and r: "(y, z) ∈ r" "(z, y) ∈ r"
from A obtain x where x: "x ∈ X" "?A x = A" by auto
then have "x ∈ A" using refl unfolding refl_on_def by auto
with x y have "(x,y) ∈ r" "(y, x) ∈ r" by auto
with r have "(x,z) ∈ r" "(z,x) ∈ r" using trans unfolding trans_def by blast+
with x z have "z ∈ A" by auto
} note A_intro' = this
{ fix A y assume A: "A ∈ ?T" and y: "y ∈ X" and r: "(?R A, y) ∈ r" "(y, ?R A) ∈ r"
with A_intro' R_in have "y ∈ A" by blast
} note A_intro = this
{ fix A B C
assume r1: "(?R A, ?R B) ∈ r" and r2: "(?R B, ?R C) ∈ r"
with trans have "(?R A, ?R C) ∈ r" unfolding trans_def by blast
} note trans_lifted[intro] = this
{ fix A B a b
assume A: "A ∈ ?T" and B: "B ∈ ?T"
and a: "a ∈ A" and b: "b ∈ B"
and r: "(a, b) ∈ r" "(b, a) ∈ r"
with R_in have "?R A ∈ A" "?R B ∈ B" by blast+
have "A = B"
proof auto
fix x assume x: "x ∈ A"
with A have "x ∈ X" by auto
from A_intro'[OF B b this] A_dest'[OF A x a] r trans[unfolded trans_def] show "x ∈ B" by blast
next
fix x assume x: "x ∈ B"
with B have "x ∈ X" by auto
from A_intro'[OF A a this] A_dest'[OF B x b] r trans[unfolded trans_def] show "x ∈ A" by blast
qed
} note eq_lifted'' = this
{ fix A B C
assume A: "A ∈ ?T" and B: "B ∈ ?T" and r: "(?R A, ?R B) ∈ r" "(?R B, ?R A) ∈ r"
with eq_lifted'' R_in have "A = B" by blast
} note eq_lifted' = this
{ fix A B C
assume A: "A ∈ ?T" and B: "B ∈ ?T" and eq: "?R A = ?R B"
from R_in[OF A] A have "?R A ∈ X" by auto
with refl have "(?R A, ?R A) ∈ r" unfolding refl_on_def by auto
with eq_lifted'[OF A B] eq have "A = B" by auto
} note eq_lifted = this
{ fix A B
assume A: "A ∈ ?T" and B: "B ∈ ?T" and neq: "A ≠ B"
from neq eq_lifted[OF A B] have "?R A ≠ ?R B" by metis
moreover from A B R_in have "?R A ∈ X" "?R B ∈ X" by auto
ultimately have "(?R A, ?R B) ∈ r ∨ (?R B, ?R A) ∈ r" using tot unfolding total_on_def by auto
} note total_lifted = this
{ fix x y assume x: "x ∈ X" and y: "y ∈ X"
from x y have "?A x ∈ ?T" "?A y ∈ ?T" by auto
from R_in[OF this(1)] R_in[OF this(2)] have "?R (?A x) ∈ ?A x" "?R (?A y) ∈ ?A y" by auto
then have "(x, ?R (?A x)) ∈ r" "(?R (?A y), y) ∈ r" "(?R (?A x), x) ∈ r" "(y, ?R (?A y)) ∈ r" by auto
with trans[unfolded trans_def] have "(x, y) ∈ r ⟷ (?R (?A x), ?R (?A y)) ∈ r" by meson
} note repr = this
interpret interp: enumerateable "{?A x | x. x ∈ X}" "λ A B. A ≠ B ∧ (?R A, ?R B) ∈ r"
proof (standard, goal_cases)
case 1
from fin show ?case by auto
next
case 2
with total_lifted show ?case by auto
next
case 3
then show ?case unfolding transp_def
proof (standard, standard, standard, standard, standard, goal_cases)
case (1 A B C)
note A = this
with trans_lifted have "(?R A,?R C) ∈ r" by blast
moreover have "A ≠ C"
proof (rule ccontr, goal_cases)
case 1
with A have "(?R A,?R B) ∈ r" "(?R B,?R A) ∈ r" by auto
with eq_lifted'[OF A(1,2)] A show False by auto
qed
ultimately show ?case by auto
qed
next
case 4
{ fix A B assume A: "A ∈ ?T" and B: "B ∈ ?T" and neq: "A ≠ B" "(?R A, ?R B) ∈ r"
with eq_lifted'[OF A B] neq have "¬ (?R B, ?R A) ∈ r" by auto
}
then show ?case by auto
qed
from interp.order_fun[OF subset_refl] obtain f :: "'a set ⇒ nat" where
f: "∀ x ∈ ?T. ∀ y ∈ ?T. f x < f y ⟷ x ≠ y ∧ (?R x, ?R y) ∈ r" "range f ⊆ {0..card ?T - 1}"
by auto
let ?f = "λ x. if x ∈ X then f (?A x) else 0"
{ fix x y assume x: "x ∈ X" and y: "y ∈ X"
have "?f x ≤ ?f y ⟷ (x, y) ∈ r"
proof (cases "x = y")
case True
with refl x show ?thesis unfolding refl_on_def by auto
next
case False
note F = this
from ex x y have *: "?A x ∈ ?T" "?A y ∈ ?T" "x ∈ ?A x" "y ∈ ?A y" by auto
show ?thesis
proof (cases "(x, y) ∈ r ∧ (y, x) ∈ r")
case True
from eq_lifted''[OF *] True x y have "?f x = ?f y" by auto
with True show ?thesis by auto
next
case False
with A_dest'[OF *(1,3), of y] *(4) have **: "?A x ≠ ?A y" by auto
from total_lifted[OF *(1,2) this] have "(?R (?A x), ?R (?A y)) ∈ r ∨ (?R (?A y), ?R (?A x)) ∈ r" .
then have neq: "?f x ≠ ?f y"
proof (standard, goal_cases)
case 1
with f *(1,2) ** have "f (?A x) < f (?A y)" by auto
with * show ?case by auto
next
case 2
with f *(1,2) ** have "f (?A y) < f (?A x)" by auto
with * show ?case by auto
qed
then have "?thesis = (?f x < ?f y ⟷ (x, y) ∈ r)" by linarith
moreover from f ** * have "(?f x < ?f y ⟷ (?R (?A x), ?R (?A y)) ∈ r)" by auto
moreover from repr * have "… ⟷ (x, y) ∈ r" by auto
ultimately show ?thesis by auto
qed
qed
}
then have "∀ x ∈ X. ∀ y ∈ X. ?f x ≤ ?f y ⟷ (x, y) ∈ r" by blast
then show ?thesis ..
qed
section ‹Finiteness›
lemma pairwise_finiteI:
assumes "finite {b. ∃a. P a b}" (is "finite ?B")
assumes "finite {a. ∃b. P a b}"
shows "finite {(a,b). P a b}" (is "finite ?C")
proof -
from assms(1) have "finite ?B" .
let ?f = "λ b. {(a,b) | a. P a b}"
{ fix b
have "?f b ⊆ {(a,b) | a. ∃b. P a b}" by blast
moreover have "finite …" using assms(2) by auto
ultimately have "finite (?f b)" by (blast intro: finite_subset)
}
with assms(1) have "finite (⋃ (?f ` ?B))" by auto
moreover have "?C ⊆ ⋃ (?f ` ?B)" by auto
ultimately show ?thesis by (blast intro: finite_subset)
qed
lemma finite_ex_and1:
assumes "finite {b. ∃a. P a b}" (is "finite ?A")
shows "finite {b. ∃a. P a b ∧ Q a b}" (is "finite ?B")
proof -
have "?B ⊆ ?A" by auto
with assms show ?thesis by (blast intro: finite_subset)
qed
lemma finite_ex_and2:
assumes "finite {b. ∃a. Q a b}" (is "finite ?A")
shows "finite {b. ∃a. P a b ∧ Q a b}" (is "finite ?B")
proof -
have "?B ⊆ ?A" by auto
with assms show ?thesis by (blast intro: finite_subset)
qed
lemma finite_set_of_finite_funs2:
fixes A :: "'a set"
and B :: "'b set"
and C :: "'c set"
and d :: "'c"
assumes "finite A"
and "finite B"
and "finite C"
shows "finite {f. ∀x. ∀y. (x ∈ A ∧ y ∈ B ⟶ f x y ∈ C) ∧ (x ∉ A ⟶ f x y = d) ∧ (y ∉ B ⟶ f x y = d)}"
proof -
let ?S = "{f. ∀x. ∀y. (x ∈ A ∧ y ∈ B ⟶ f x y ∈ C) ∧ (x ∉ A ⟶ f x y = d) ∧ (y ∉ B ⟶ f x y = d)}"
let ?R = "{g. ∀x. (x ∈ B ⟶ g x ∈ C) ∧ (x ∉ B ⟶ g x = d)}"
let ?Q = "{f. ∀x. (x ∈ A ⟶ f x ∈ ?R) ∧ (x ∉ A ⟶ f x = (λy. d))}"
from finite_set_of_finite_funs[OF assms(2,3)] have "finite ?R" .
from finite_set_of_finite_funs[OF assms(1) this, of "λ y. d"] have "finite ?Q" .
moreover have "?S = ?Q" by auto (case_tac "xa ∈ A", auto)
ultimately show ?thesis by simp
qed
section ‹Numbering the elements of finite sets›
lemma upt_last_append: "a ≤ b ⟹ [a..<b] @ [b] = [a ..< Suc b]" by (induction b) auto
lemma map_of_zip_dom_to_range:
"a ∈ set A ⟹ length B = length A ⟹ the (map_of (zip A B) a) ∈ set B"
by (metis map_of_SomeD map_of_zip_is_None option.collapse set_zip_rightD)
lemma zip_range_id:
"length A = length B ⟹ snd ` set (zip A B) = set B"
by (metis map_snd_zip set_map)
lemma map_of_zip_in_range:
"distinct A ⟹ length B = length A ⟹ b ∈ set B ⟹ ∃ a ∈ set A. the (map_of (zip A B) a) = b"
proof goal_cases
case 1
from ran_distinct[of "zip A B"] 1(1,2) have
"ran (map_of (zip A B)) = set B"
by (auto simp: zip_range_id)
with 1(3) obtain a where "map_of (zip A B) a = Some b" unfolding ran_def by auto
with map_of_zip_is_Some[OF 1(2)[symmetric]] have "the (map_of (zip A B) a) = b" "a ∈ set A" by auto
then show ?case by blast
qed
lemma distinct_zip_inj:
"distinct ys ⟹ (a, b) ∈ set (zip xs ys) ⟹ (c, b) ∈ set (zip xs ys) ⟹ a = c"
proof (induction ys arbitrary: xs)
case Nil then show ?case by auto
next
case (Cons y ys)
from this(3) have "xs ≠ []" by auto
then obtain z zs where xs: "xs = z # zs" by (cases xs) auto
show ?case
proof (cases "(a, b) ∈ set (zip zs ys)")
case True
note T = this
then have b: "b ∈ set ys" by (meson in_set_zipE)
show ?thesis
proof (cases "(c, b) ∈ set (zip zs ys)")
case True
with T Cons show ?thesis by auto
next
case False
with Cons.prems xs b show ?thesis by auto
qed
next
case False
with Cons.prems xs have b: "a = z" "b = y" by auto
show ?thesis
proof (cases "(c, b) ∈ set (zip zs ys)")
case True
then have "b ∈ set ys" by (meson in_set_zipE)
with b ‹distinct (y#ys)› show ?thesis by auto
next
case False
with Cons.prems xs b show ?thesis by auto
qed
qed
qed
lemma map_of_zip_distinct_inj:
"distinct B ⟹ length A = length B ⟹ inj_on (the o map_of (zip A B)) (set A)"
unfolding inj_on_def proof (clarify, goal_cases)
case (1 x y)
with map_of_zip_is_Some[OF 1(2)] obtain a where
"map_of (zip A B) x = Some a" "map_of (zip A B) y = Some a"
by auto
then have "(x, a) ∈ set (zip A B)" "(y, a) ∈ set (zip A B)" using map_of_SomeD by metis+
from distinct_zip_inj[OF _ this] 1 show ?case by auto
qed
lemma nat_not_ge_1D: "¬ Suc 0 ≤ x ⟹ x = 0" by auto
lemma standard_numbering:
assumes "finite A"
obtains v :: "'a ⇒ nat" and n where "bij_betw v A {1..n}"
and "∀ c ∈ A. v c > 0"
and "∀ c. c ∉ A ⟶ v c > n"
proof -
from assms obtain L where L: "distinct L" "set L = A" by (meson finite_distinct_list)
let ?N = "length L + 1"
let ?P = "zip L [1..<?N]"
let ?v = "λ x. let v = map_of ?P x in if v = None then ?N else the v"
from length_upt have len: "length [1..<?N] = length L" by auto (cases L, auto)
then have lsimp: "length [Suc 0 ..<Suc (length L)] = length L" by simp
note * = map_of_zip_dom_to_range[OF _ len]
have "bij_betw ?v A {1..length L}" unfolding bij_betw_def
proof
show "?v ` A = {1..length L}" apply auto
apply (auto simp: L)[]
apply (auto simp only: upt_last_append)[] using * apply force
using * apply (simp only: upt_last_append) apply force
apply (simp only: upt_last_append) using L(2) apply (auto dest: nat_not_ge_1D)
apply (subgoal_tac "x ∈ set [1..< length L +1]")
apply (force dest!: map_of_zip_in_range[OF L(1) len])
apply auto
done
next
from L map_of_zip_distinct_inj[OF distinct_upt, of L 1 "length L + 1"] len
have "inj_on (the o map_of ?P) A" by auto
moreover have "inj_on (the o map_of ?P) A = inj_on ?v A"
using len L(2) by - (rule inj_on_cong, auto)
ultimately show "inj_on ?v A" by blast
qed
moreover have "∀ c ∈ A. ?v c > 0"
proof
fix c
show "?v c > 0"
proof (cases "c ∈ set L")
case False
then show ?thesis by auto
next
case True
with dom_map_of_zip[OF len[symmetric]] obtain x where
"Some x = map_of ?P c" "x ∈ set [1..<length L + 1]"
by (metis * domIff option.collapse)
then have "?v c ∈ set [1..<length L + 1]" using * True len by auto
then show ?thesis by auto
qed
qed
moreover have "∀ c. c ∉ A ⟶ ?v c > length L" using L by auto
ultimately show ?thesis ..
qed
end
Theory DBM_Normalization
section ‹Normalization of DBMs›
theory DBM_Normalization
imports DBM_Basics
begin
text ‹This is the implementation of the common approximation operation.›
fun norm_upper :: "('t::time) DBMEntry ⇒ 't ⇒ ('t::time) DBMEntry"
where
"norm_upper e t = (if Le t ≺ e then ∞ else e)"
fun norm_lower :: "('t::time) DBMEntry ⇒ 't ⇒ ('t::time) DBMEntry"
where
"norm_lower e t = (if e ≺ Lt t then Lt t else e)"
text ‹
Note that literature pretends that ‹𝟬› would have some (presumably infinite bound) in ‹k›
and thus defines normalization uniformly. The easiest way to get around this seems to explicate
this in the definition as below.
›
definition norm :: "('t::time) DBM ⇒ (nat ⇒ 't) ⇒ nat ⇒ 't DBM"
where
"norm M k n ≡ λ i j.
let ub = if i > 0 then (k i) else 0 in
let lb = if j > 0 then (- k j) else 0 in
if i ≤ n ∧ j ≤ n then norm_lower (norm_upper (M i j) ub) lb else M i j
"
section ‹Normalization is a Widening Operator›
lemma norm_mono:
assumes "∀c. v c > 0" "u ∈ [M]⇘v,n⇙"
shows "u ∈ [norm M k n]⇘v,n⇙" (is "u ∈ [?M2]⇘v,n⇙")
proof -
note A = assms
note M1 = A(2)[unfolded DBM_zone_repr_def DBM_val_bounded_def]
show ?thesis
proof (unfold DBM_zone_repr_def DBM_val_bounded_def, auto)
show "Le 0 ≼ ?M2 0 0"
using A unfolding norm_def DBM_zone_repr_def DBM_val_bounded_def dbm_le_def by auto
next
fix c assume "v c ≤ n"
with M1 have M1: "dbm_entry_val u None (Some c) (M 0 (v c))" by auto
from ‹v c ≤ n› A have *:
"?M2 0 (v c) = norm_lower (norm_upper (M 0 (v c)) 0) (- k (v c))"
unfolding norm_def by auto
show "dbm_entry_val u None (Some c) (?M2 0 (v c))"
proof (cases "M 0 (v c) ≺ Lt (- k (v c))")
case True
show ?thesis
proof (cases "Le 0 ≺ M 0 (v c)")
case True with * show ?thesis by auto
next
case False
with * True have "?M2 0 (v c) = Lt (- k (v c))" by auto
moreover from True dbm_entry_val_mono_2[OF M1] have
"dbm_entry_val u None (Some c) (Lt (- k (v c)))"
by auto
ultimately show ?thesis by auto
qed
next
case False
show ?thesis
proof (cases "Le 0 ≺ M 0 (v c)")
case True with * show ?thesis by auto
next
case F: False
with M1 * False show ?thesis by auto
qed
qed
next
fix c assume "v c ≤ n"
with M1 have M1: "dbm_entry_val u (Some c) None (M (v c) 0)" by auto
from ‹v c ≤ n› A have *:
"?M2 (v c) 0 = norm_lower (norm_upper (M (v c) 0) (k (v c))) 0"
unfolding norm_def by auto
show "dbm_entry_val u (Some c) None (?M2 (v c) 0)"
proof (cases "Le (k (v c)) ≺ M (v c) 0")
case True
with A(1,2) ‹v c ≤ n› have "?M2 (v c) 0 = ∞" unfolding norm_def by auto
then show ?thesis by auto
next
case False
show ?thesis
proof (cases "M (v c) 0 ≺ Lt 0")
case True with False * dbm_entry_val_mono_3[OF M1] show ?thesis by auto
next
case F: False
with M1 * False show ?thesis by auto
qed
qed
next
fix c1 c2 assume "v c1 ≤ n" "v c2 ≤ n"
with M1 have M1: "dbm_entry_val u (Some c1) (Some c2) (M (v c1) (v c2))" by auto
then show "dbm_entry_val u (Some c1) (Some c2) (?M2 (v c1) (v c2))"
proof (cases "Le (k (v c1)) ≺ M (v c1) (v c2)")
case True
with A(1,2) ‹v c1 ≤ n› ‹v c2 ≤ n› have "?M2 (v c1) (v c2) = ∞" unfolding norm_def by auto
then show ?thesis by auto
next
case False
with A(1,2) ‹v c1 ≤ n› ‹v c2 ≤ n› have
*: "?M2 (v c1) (v c2) = norm_lower (M (v c1) (v c2)) (- k (v c2))"
unfolding norm_def by auto
show ?thesis
proof (cases "M (v c1) (v c2) ≺ Lt (- k (v c2))")
case True
with dbm_entry_val_mono_1[OF M1] have
"dbm_entry_val u (Some c1) (Some c2) (Lt (- k (v c2)))"
by auto
then have "u c1 - u c2 < - k (v c2)" by auto
with * True show ?thesis by auto
next
case False with M1 * show ?thesis by auto
qed
qed
qed
qed
end
Theory Regions_Beta
theory Regions_Beta
imports Misc DBM_Normalization DBM_Operations
begin
chapter ‹Refinement to ‹β›-regions›
section ‹Definition›
type_synonym 'c ceiling = "('c ⇒ nat)"
datatype intv =
Const nat |
Intv nat |
Greater nat
datatype intv' =
Const' int |
Intv' int |
Greater' int |
Smaller' int
type_synonym t = real
instantiation real :: time
begin
instance proof
fix x y :: real
assume "x < y"
then show "∃z>x. z < y" using dense_order_class.dense by blast
next
have "(1 :: real) ≠ 0" by auto
then show "∃x. (x::real) ≠ 0" ..
qed
end
inductive valid_intv :: "nat ⇒ intv ⇒ bool"
where
"0 ≤ d ⟹ d ≤ c ⟹ valid_intv c (Const d)" |
"0 ≤ d ⟹ d < c ⟹ valid_intv c (Intv d)" |
"valid_intv c (Greater c)"
inductive valid_intv' :: "int ⇒ int ⇒ intv' ⇒ bool"
where
"valid_intv' l _ (Smaller' (-l))" |
"-l ≤ d ⟹ d ≤ u ⟹ valid_intv' l u (Const' d)" |
"-l ≤ d ⟹ d < u ⟹ valid_intv' l u (Intv' d)" |
"valid_intv' _ u (Greater' u)"
inductive intv_elem :: "'c ⇒ ('c,t) cval ⇒ intv ⇒ bool"
where
"u x = d ⟹ intv_elem x u (Const d)" |
"d < u x ⟹ u x < d + 1 ⟹ intv_elem x u (Intv d)" |
"c < u x ⟹ intv_elem x u (Greater c)"
inductive intv'_elem :: "'c ⇒ 'c ⇒ ('c,t) cval ⇒ intv' ⇒ bool"
where
"u x - u y < c ⟹ intv'_elem x y u (Smaller' c)" |
"u x - u y = d ⟹ intv'_elem x y u (Const' d)" |
"d < u x - u y ⟹ u x - u y < d + 1 ⟹ intv'_elem x y u (Intv' d)" |
"c < u x - u y ⟹ intv'_elem x y u (Greater' c)"
abbreviation "total_preorder r ≡ refl r ∧ trans r"
inductive isConst :: "intv ⇒ bool"
where
"isConst (Const _)"
inductive isIntv :: "intv ⇒ bool"
where
"isIntv (Intv _)"
inductive isGreater :: "intv ⇒ bool"
where
"isGreater (Greater _)"
declare isIntv.intros[intro!] isConst.intros[intro!] isGreater.intros[intro!]
declare isIntv.cases[elim!] isConst.cases[elim!] isGreater.cases[elim!]
inductive valid_region :: "'c set ⇒ ('c ⇒ nat) ⇒ ('c ⇒ intv) ⇒ ('c ⇒ 'c ⇒ intv') ⇒ 'c rel ⇒ bool"
where
"⟦X⇩0 = {x ∈ X. ∃ d. I x = Intv d}; refl_on X⇩0 r; trans r; total_on X⇩0 r; ∀ x ∈ X. valid_intv (k x) (I x);
∀ x ∈ X. ∀ y ∈ X. isGreater (I x) ∨ isGreater (I y) ⟶ valid_intv' (k y) (k x) (J x y)⟧
⟹ valid_region X k I J r"
inductive_set region for X I J r
where
"∀ x ∈ X. u x ≥ 0 ⟹ ∀ x ∈ X. intv_elem x u (I x) ⟹ X⇩0 = {x ∈ X. ∃ d. I x = Intv d} ⟹
∀ x ∈ X⇩0. ∀ y ∈ X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y) ⟹
∀ x ∈ X. ∀ y ∈ X. isGreater (I x) ∨ isGreater (I y) ⟶ intv'_elem x y u (J x y)
⟹ u ∈ region X I J r"
text ‹Defining the unique element of a partition that contains a valuation›
definition part ("[_]⇩_" [61,61] 61) where "part v ℛ ≡ THE R. R ∈ ℛ ∧ v ∈ R"
text ‹
First we need to show that the set of regions is a partition of the set of all clock
assignments. This property is only claimed by P. Bouyer.
›
inductive_cases[elim!]: "intv_elem x u (Const d)"
inductive_cases[elim!]: "intv_elem x u (Intv d)"
inductive_cases[elim!]: "intv_elem x u (Greater d)"
inductive_cases[elim!]: "valid_intv c (Greater d)"
inductive_cases[elim!]: "valid_intv c (Const d)"
inductive_cases[elim!]: "valid_intv c (Intv d)"
inductive_cases[elim!]: "intv'_elem x y u (Const' d)"
inductive_cases[elim!]: "intv'_elem x y u (Intv' d)"
inductive_cases[elim!]: "intv'_elem x y u (Greater' d)"
inductive_cases[elim!]: "intv'_elem x y u (Smaller' d)"
inductive_cases[elim!]: "valid_intv' l u (Greater' d)"
inductive_cases[elim!]: "valid_intv' l u (Smaller' d)"
inductive_cases[elim!]: "valid_intv' l u (Const' d)"
inductive_cases[elim!]: "valid_intv' l u (Intv' d)"
declare valid_intv.intros[intro]
declare valid_intv'.intros[intro]
declare intv_elem.intros[intro]
declare intv'_elem.intros[intro]
declare region.cases[elim]
declare valid_region.cases[elim]
section ‹Basic Properties›
text ‹First we show that all valid intervals are distinct›
lemma valid_intv_distinct:
"valid_intv c I ⟹ valid_intv c I' ⟹ intv_elem x u I ⟹ intv_elem x u I' ⟹ I = I'"
by (cases I) (cases I', auto)+
lemma valid_intv'_distinct:
"-c ≤ d ⟹ valid_intv' c d I ⟹ valid_intv' c d I' ⟹ intv'_elem x y u I ⟹ intv'_elem x y u I'
⟹ I = I'"
by (cases I) (cases I', auto)+
text ‹From this we show that all valid regions are distinct›
lemma valid_regions_distinct:
"valid_region X k I J r ⟹ valid_region X k I' J' r' ⟹ v ∈ region X I J r ⟹ v ∈ region X I' J' r'
⟹ region X I J r = region X I' J' r'"
proof goal_cases
case 1
note A = 1
{ fix x assume x: "x ∈ X"
with A(1) have "valid_intv (k x) (I x)" by auto
moreover from A(2) x have "valid_intv (k x) (I' x)" by auto
moreover from A(3) x have "intv_elem x v (I x)" by auto
moreover from A(4) x have "intv_elem x v (I' x)" by auto
ultimately have "I x = I' x" using valid_intv_distinct by fastforce
} note * = this
{ fix x y assume x: "x ∈ X" and y: "y ∈ X" and B: "isGreater (I x) ∨ isGreater (I y)"
with * have C: "isGreater (I' x) ∨ isGreater (I' y)" by auto
from A(1) x y B have "valid_intv' (k y) (k x) (J x y)" by fastforce
moreover from A(2) x y C have "valid_intv' (k y) (k x) (J' x y)" by fastforce
moreover from A(3) x y B have "intv'_elem x y v (J x y)" by force
moreover from A(4) x y C have "intv'_elem x y v (J' x y)" by force
moreover from x y valid_intv'_distinct have "- int (k y) ≤ int (k x)" by simp
ultimately have "J x y = J' x y" by (blast intro: valid_intv'_distinct)
} note ** = this
from A show ?thesis
proof (auto, goal_cases)
case (1 u)
note A = this
{ fix x assume x: "x ∈ X"
from A(5) x have "intv_elem x u (I x)" by auto
with * x have "intv_elem x u (I' x)" by auto
}
then have "∀ x ∈ X. intv_elem x u (I' x)" by auto
note B = this
{ fix x y assume x: "x ∈ X" and y: "y ∈ X" and B: "isGreater (I' x) ∨ isGreater (I' y)"
with * have "isGreater (I x) ∨ isGreater (I y)" by auto
with x y A(5) have "intv'_elem x y u (J x y)" by force
with **[OF x y ‹isGreater (I x) ∨ _›] have "intv'_elem x y u (J' x y)" by simp
} note C = this
let ?X⇩0 = "{x ∈ X. ∃ d. I' x = Intv d}"
{ fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
have "(x, y) ∈ r' ⟷ frac (u x) ≤ frac (u y)"
proof
assume "frac (u x) ≤ frac (u y)"
with A(5) x y * have "(x,y) ∈ r" by auto
with A(3) x y * have "frac (v x) ≤ frac (v y)" by auto
with A(4) x y show "(x,y) ∈ r'" by auto
next
assume "(x,y) ∈ r'"
with A(4) x y have "frac (v x) ≤ frac (v y)" by auto
with A(3) x y * have "(x,y) ∈ r" by auto
with A(5) x y * show "frac (u x) ≤ frac (u y)" by auto
qed
}
then have *: "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r' ⟷ frac (u x) ≤ frac (u y)" by auto
from A(5) have "∀x∈X. 0 ≤ u x" by auto
from region.intros[OF this B _ *] C show ?case by auto
next
case (2 u)
note A = this
{ fix x assume x: "x ∈ X"
from A(5) x have "intv_elem x u (I' x)" by auto
with * x have "intv_elem x u (I x)" by auto
}
then have "∀ x ∈ X. intv_elem x u (I x)" by auto
note B = this
{ fix x y assume x: "x ∈ X" and y: "y ∈ X" and B: "isGreater (I x) ∨ isGreater (I y)"
with * have "isGreater (I' x) ∨ isGreater (I' y)" by auto
with x y A(5) have "intv'_elem x y u (J' x y)" by force
with **[OF x y ‹isGreater (I x) ∨ _›] have "intv'_elem x y u (J x y)" by simp
} note C = this
let ?X⇩0 = "{x ∈ X. ∃ d. I x = Intv d}"
{ fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
have "(x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)"
proof
assume "frac (u x) ≤ frac (u y)"
with A(5) x y * have "(x,y) ∈ r'" by auto
with A(4) x y * have "frac (v x) ≤ frac (v y)" by auto
with A(3) x y show "(x,y) ∈ r" by auto
next
assume "(x,y) ∈ r"
with A(3) x y have "frac (v x) ≤ frac (v y)" by auto
with A(4) x y * have "(x,y) ∈ r'" by auto
with A(5) x y * show "frac (u x) ≤ frac (u y)" by auto
qed
}
then have *:"∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)" by auto
from A(5) have "∀x∈X. 0 ≤ u x" by auto
from region.intros[OF this B _ *] C show ?case by auto
qed
qed
locale Beta_Regions =
fixes X k ℛ and V :: "('c, t) cval set"
defines "ℛ ≡ {region X I J r | I J r. valid_region X k I J r}"
defines "V ≡ {v . ∀ x ∈ X. v x ≥ 0}"
assumes finite: "finite X"
assumes non_empty: "X ≠ {}"
begin
lemma ℛ_regions_distinct:
"⟦R ∈ ℛ; v ∈ R; R' ∈ ℛ; R ≠ R'⟧ ⟹ v ∉ R'"
unfolding ℛ_def using valid_regions_distinct by blast
text ‹
Secondly, we also need to show that every valuations belongs to a region which is part of
the partition.
›
definition intv_of :: "nat ⇒ t ⇒ intv" where
"intv_of c v ≡
if (v > c) then Greater c
else if (∃ x :: nat. x = v) then (Const (nat (floor v)))
else (Intv (nat (floor v)))"
definition intv'_of :: "int ⇒ int ⇒ t ⇒ intv'" where
"intv'_of l u v ≡
if (v > u) then Greater' u
else if (v < l) then Smaller' l
else if (∃ x :: int. x = v) then (Const' (floor v))
else (Intv' (floor v))"
lemma region_cover:
"∀ x ∈ X. v x ≥ 0 ⟹ ∃ R. R ∈ ℛ ∧ v ∈ R"
proof (standard, standard)
assume assm: "∀ x ∈ X. 0 ≤ v x"
let ?I = "λ x. intv_of (k x) (v x)"
let ?J = "λ x y. intv'_of (-k y) (k x) (v x - v y)"
let ?X⇩0 = "{x ∈ X. ∃ d. ?I x = Intv d}"
let ?r = "{(x,y). x ∈ ?X⇩0 ∧ y ∈ ?X⇩0 ∧ frac (v x) ≤ frac (v y)}"
{ fix x y d assume A: "x ∈ X" "y ∈ X"
then have "intv'_elem x y v (intv'_of (- int (k y)) (int (k x)) (v x - v y))" unfolding intv'_of_def
proof (auto, goal_cases)
case (1 a)
then have "⌊v x - v y⌋ = v x - v y" by (metis of_int_floor_cancel)
then show ?case by auto
next
case 2
then have "⌊v x - v y⌋ < v x - v y" by (meson eq_iff floor_eq_iff not_less)
with 2 show ?case by auto
qed
} note intro = this
show "v ∈ region X ?I ?J ?r"
proof (standard, auto simp: assm intro: intro, goal_cases)
case (1 x)
thus ?case unfolding intv_of_def
proof (auto, goal_cases)
case (1 a)
note A = this
from A(2) have "⌊v x⌋ = v x" by (metis floor_of_int of_int_of_nat_eq)
with assm A(1) have "v x = real (nat ⌊v x⌋)" by auto
then show ?case by auto
next
case 2
note A = this
from A(1,2) have "real (nat ⌊v x⌋) < v x"
proof -
have f1: "0 ≤ v x"
using assm 1 by blast
have "v x ≠ real_of_int (int (nat ⌊v x⌋))"
by (metis (no_types) 2(2) of_int_of_nat_eq)
then show ?thesis
using f1 by linarith
qed
moreover from assm have "v x < real (nat (⌊v x⌋) + 1)" by linarith
ultimately show ?case by auto
qed
qed
{ fix x y assume "x ∈ X" "y ∈ X"
then have "valid_intv' (int (k y)) (int (k x)) (intv'_of (- int (k y)) (int (k x)) (v x - v y))"
unfolding intv'_of_def
apply auto
apply (metis floor_of_int le_floor_iff linorder_not_less of_int_minus of_int_of_nat_eq valid_intv'.simps)
by (metis floor_less_iff less_eq_real_def not_less of_int_minus of_int_of_nat_eq valid_intv'.intros(3))
}
moreover
{ fix x assume x: "x ∈ X"
then have "valid_intv (k x) (intv_of (k x) (v x))"
proof (auto simp: intv_of_def, goal_cases)
case (1 a)
then show ?case
by (intro valid_intv.intros(1)) (auto, linarith)
next
case 2
then show ?case
apply (intro valid_intv.intros(2))
using assm floor_less_iff nat_less_iff by fastforce+
qed
}
ultimately have "valid_region X k ?I ?J ?r"
by (intro valid_region.intros, auto simp: refl_on_def trans_def total_on_def)
then show "region X ?I ?J ?r ∈ ℛ" unfolding ℛ_def by auto
qed
lemma region_cover_V: "v ∈ V ⟹ ∃ R. R ∈ ℛ ∧ v ∈ R" using region_cover unfolding V_def by simp
text ‹
Note that we cannot show that every region is non-empty anymore.
The problem are regions fixing differences between an 'infeasible' constant.
›
text ‹
We can show that there is always exactly one region a valid valuation belongs to.
Note that we do not need non-emptiness for that.
›
lemma regions_partition:
"∀x ∈ X. 0 ≤ v x ⟹ ∃! R ∈ ℛ. v ∈ R"
proof goal_cases
case 1
note A = this
with region_cover[OF ] obtain R where R: "R ∈ ℛ ∧ v ∈ R" by fastforce
moreover
{ fix R' assume "R' ∈ ℛ ∧ v ∈ R'"
with R valid_regions_distinct[OF _ _ _ _] have "R' = R" unfolding ℛ_def by blast
}
ultimately show ?thesis by auto
qed
lemma region_unique:
"v ∈ R ⟹ R ∈ ℛ ⟹ [v]⇩ℛ = R"
proof goal_cases
case 1
note A = this
from A obtain I J r where *:
"valid_region X k I J r" "R = region X I J r" "v ∈ region X I J r"
by (auto simp: ℛ_def)
from this(3) have "∀x∈X. 0 ≤ v x" by auto
from theI'[OF regions_partition[OF this]] obtain I' J' r' where
v: "valid_region X k I' J' r'" "[v]⇩ℛ = region X I' J' r'" "v ∈ region X I' J' r'"
unfolding part_def ℛ_def by auto
from valid_regions_distinct[OF *(1) v(1) *(3) v(3)] v(2) *(2) show ?case by auto
qed
lemma regions_partition':
"∀x∈X. 0 ≤ v x ⟹ ∀x∈X. 0 ≤ v' x ⟹ v' ∈ [v]⇩ℛ ⟹ [v']⇩ℛ = [v]⇩ℛ"
proof goal_cases
case 1
note A = this
from theI'[OF regions_partition[OF A(1)]] A(3) obtain I J r where
v: "valid_region X k I J r" "[v]⇩ℛ = region X I J r" "v' ∈ region X I J r"
unfolding part_def ℛ_def by blast
from theI'[OF regions_partition[OF A(2)]] obtain I' J' r' where
v': "valid_region X k I' J' r'" "[v']⇩ℛ = region X I' J' r'" "v' ∈ region X I' J' r'"
unfolding part_def ℛ_def by auto
from valid_regions_distinct[OF v'(1) v(1) v'(3) v(3)] v(2) v'(2) show ?case by simp
qed
lemma regions_closed:
"R ∈ ℛ ⟹ v ∈ R ⟹ t ≥ 0 ⟹ [v ⊕ t]⇩ℛ ∈ ℛ"
proof goal_cases
case 1
note A = this
then obtain I J r where "v ∈ region X I J r" unfolding ℛ_def by auto
from this(1) have "∀ x ∈ X. v x ≥ 0" by auto
with A(3) have "∀ x ∈ X. (v ⊕ t) x ≥ 0" unfolding cval_add_def by simp
from regions_partition[OF this] obtain R' where "R' ∈ ℛ" "(v ⊕ t) ∈ R'" by auto
with region_unique[OF this(2,1)] show ?case by auto
qed
lemma regions_closed':
"R ∈ ℛ ⟹ v ∈ R ⟹ t ≥ 0 ⟹ (v ⊕ t) ∈ [v ⊕ t]⇩ℛ"
proof goal_cases
case 1
note A = this
then obtain I J r where "v ∈ region X I J r" unfolding ℛ_def by auto
from this(1) have "∀ x ∈ X. v x ≥ 0" by auto
with A(3) have "∀ x ∈ X. (v ⊕ t) x ≥ 0" unfolding cval_add_def by simp
from regions_partition[OF this] obtain R' where "R' ∈ ℛ" "(v ⊕ t) ∈ R'" by auto
with region_unique[OF this(2,1)] show ?case by auto
qed
lemma valid_regions_I_cong:
"valid_region X k I J r ⟹ ∀ x ∈ X. I x = I' x
⟹ ∀ x ∈ X. ∀ y ∈ X. (isGreater (I x) ∨ isGreater (I y)) ⟶ J x y = J' x y
⟹ region X I J r = region X I' J' r ∧ valid_region X k I' J' r"
proof (auto, goal_cases)
case (1 v)
note A = this
then have [simp]:
"⋀ x. x ∈ X ⟹ I' x = I x"
"⋀ x y. x ∈ X ⟹ y ∈ X ⟹ isGreater (I x) ∨ isGreater (I y) ⟹ J x y = J' x y"
by metis+
show ?case
proof (standard, goal_cases)
case 1 from A(4) show ?case by auto
next
case 2 from A(4) show ?case by auto
next
case 3 show "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}" by auto
next
case 4
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
from A(4) show "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. ((x, y) ∈ r) = (frac (v x) ≤ frac (v y))" by auto
next
case 5 from A(4) show ?case by force
qed
next
case (2 v)
note A = this
then have [simp]:
"⋀ x. x ∈ X ⟹ I' x = I x"
"⋀ x y. x ∈ X ⟹ y ∈ X ⟹ isGreater (I x) ∨ isGreater (I y) ⟹ J x y = J' x y"
by metis+
show ?case
proof (standard, goal_cases)
case 1 from A(4) show ?case by auto
next
case 2 from A(4) show ?case by auto
next
case 3
show "{x ∈ X. ∃d. I' x = Intv d} = {x ∈ X. ∃d. I x = Intv d}" by auto
next
case 4
let ?X⇩0 = "{x ∈ X. ∃d. I' x = Intv d}"
from A(4) show "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. ((x, y) ∈ r) = (frac (v x) ≤ frac (v y))" by auto
next
case 5 from A(4) show ?case by force
qed
next
case 3
note A = this
then have [simp]:
"⋀ x. x ∈ X ⟹ I' x = I x"
"⋀ x y. x ∈ X ⟹ y ∈ X ⟹ isGreater (I x) ∨ isGreater (I y) ⟹ J x y = J' x y"
by metis+
show ?case
apply rule
apply (subgoal_tac "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}")
apply assumption
using A by force+
qed
fun intv_const :: "intv ⇒ nat"
where
"intv_const (Const d) = d" |
"intv_const (Intv d) = d" |
"intv_const (Greater d) = d"
fun intv'_const :: "intv' ⇒ int"
where
"intv'_const (Smaller' d) = d" |
"intv'_const (Const' d) = d" |
"intv'_const (Intv' d) = d" |
"intv'_const (Greater' d) = d"
lemma finite_ℛ_aux:
fixes P A B assumes "finite {x. A x}" "finite {x. B x}"
shows "finite {(I, J) | I J. P I J r ∧ A I ∧ B J}"
using assms by (fastforce intro: pairwise_finiteI finite_ex_and1 finite_ex_and2)
lemma finite_ℛ:
notes [[simproc add: finite_Collect]]
shows "finite ℛ"
proof -
{ fix I J r assume A: "valid_region X k I J r"
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
from A have "refl_on ?X⇩0 r" by auto
then have "r ⊆ X × X" by (auto simp: refl_on_def)
then have "r ∈ Pow (X × X)" by auto
}
then have "{r. ∃I J. valid_region X k I J r} ⊆ Pow (X × X)" by auto
from finite_subset[OF this] finite have fin: "finite {r. ∃I J. valid_region X k I J r}" by auto
let ?u = "Max {k x | x. x ∈ X}"
let ?l = "- Max {k x | x. x ∈ X}"
let ?I = "{intv. intv_const intv ≤ ?u}"
let ?J = "{intv. ?l ≤ intv'_const intv ∧ intv'_const intv ≤ ?u}"
let ?S = "{r. ∃I J. valid_region X k I J r}"
let ?fin_mapI = "λ I. ∀x. (x ∈ X ⟶ I x ∈ ?I) ∧ (x ∉ X ⟶ I x = Const 0)"
let ?fin_mapJ = "λ J. ∀x. ∀y. (x ∈ X ∧ y ∈ X ⟶ J x y ∈ ?J)
∧ (x ∉ X ⟶ J x y = Const' 0) ∧ (y ∉ X ⟶ J x y = Const' 0)"
let ?ℛ = "{region X I J r | I J r. valid_region X k I J r ∧ ?fin_mapI I ∧ ?fin_mapJ J}"
let ?f = "λr. {region X I J r | I J . valid_region X k I J r ∧ ?fin_mapI I ∧ ?fin_mapJ J}"
let ?g = "λr. {(I, J) | I J . valid_region X k I J r ∧ ?fin_mapI I ∧ ?fin_mapJ J}"
have "?I = (Const ` {d. d ≤ ?u}) ∪ (Intv ` {d. d ≤ ?u}) ∪ (Greater ` {d. d ≤ ?u})"
by auto (case_tac x, auto)
then have "finite ?I" by auto
from finite_set_of_finite_funs[OF ‹finite X› this] have finI: "finite {I. ?fin_mapI I}" .
have "?J = (Smaller' ` {d. ?l ≤ d ∧ d ≤ ?u}) ∪ (Const' ` {d. ?l ≤ d ∧ d ≤ ?u})
∪ (Intv' ` {d. ?l ≤ d ∧ d ≤ ?u}) ∪ (Greater' ` {d. ?l ≤ d ∧ d ≤ ?u})"
by auto (case_tac x, auto)
then have "finite ?J" by auto
from finite_set_of_finite_funs2[OF ‹finite X› ‹finite X› this] have finJ: "finite {J. ?fin_mapJ J}" .
from finite_ℛ_aux[OF finI finJ, of "valid_region X k"] have "∀r ∈ ?S. finite (?g r)" by simp
moreover have "∀ r ∈ ?S. ?f r = (λ (I, J). region X I J r) ` ?g r" by auto
ultimately have "∀r ∈ ?S. finite (?f r)" by auto
moreover have "?ℛ = ⋃ (?f `?S)" by auto
ultimately have "finite ?ℛ" using fin by auto
moreover have "ℛ ⊆ ?ℛ"
proof
fix R assume R: "R ∈ ℛ"
then obtain I J r where I: "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
let ?I = "λ x. if x ∈ X then I x else Const 0"
let ?J = "λ x y. if x ∈ X ∧ y ∈ X ∧ (isGreater (I x) ∨ isGreater (I y)) then J x y else Const' 0"
let ?R = "region X ?I ?J r"
from valid_regions_I_cong[OF I(2)] I have *: "R = ?R" "valid_region X k ?I ?J r" by auto
have "∀x. x ∉ X ⟶ ?I x = Const 0" by auto
moreover have "∀x. x ∈ X ⟶ intv_const (I x) ≤ ?u"
proof auto
fix x assume x: "x ∈ X"
with I(2) have "valid_intv (k x) (I x)" by auto
moreover from ‹finite X› x have "k x ≤ ?u" by (auto intro: Max_ge)
ultimately show "intv_const (I x) ≤ Max {k x |x. x ∈ X}" by (cases "I x") auto
qed
ultimately have **: "?fin_mapI ?I" by auto
have "∀x y. x ∉ X ⟶ ?J x y = Const' 0" by auto
moreover have "∀x y. y ∉ X ⟶ ?J x y = Const' 0" by auto
moreover have "∀x. ∀ y. x ∈ X ∧ y ∈ X ⟶ ?l ≤ intv'_const (?J x y) ∧ intv'_const (?J x y) ≤ ?u"
proof clarify
fix x y assume x: "x ∈ X" assume y: "y ∈ X"
show "?l ≤ intv'_const (?J x y) ∧ intv'_const (?J x y) ≤ ?u"
proof (cases "isGreater (I x) ∨ isGreater (I y)")
case True
with x y I(2) have "valid_intv' (k y) (k x) (J x y)" by fastforce
moreover from ‹finite X› x have "k x ≤ ?u" by (auto intro: Max_ge)
moreover from ‹finite X› y have "?l ≤ -k y" by (auto intro: Max_ge)
ultimately show ?thesis by (cases "J x y") auto
next
case False then show ?thesis by auto
qed
qed
ultimately have "?fin_mapJ ?J" by auto
with * ** show "R ∈ ?ℛ" by blast
qed
ultimately show "finite ℛ" by (blast intro: finite_subset)
qed
end
section ‹Approximation with ‹β›-regions›
locale Beta_Regions' = Beta_Regions +
fixes v n not_in_X
assumes clock_numbering: "∀ c. v c > 0 ∧ (∀x. ∀y. v x ≤ n ∧ v y ≤ n ∧ v x = v y ⟶ x = y)"
"∀k :: nat ≤n. k > 0 ⟶ (∃c ∈ X. v c = k)" "∀ c ∈ X. v c ≤ n"
assumes not_in_X: "not_in_X ∉ X"
begin
definition "v' ≡ λ i. if i ≤ n then (THE c. c ∈ X ∧ v c = i) else not_in_X"
lemma v_v':
"∀ c ∈ X. v' (v c) = c"
using clock_numbering unfolding v'_def by auto
abbreviation
"vabstr (S :: ('a, t) zone) M ≡ S = [M]⇘v,n⇙ ∧ (∀ i≤n. ∀ j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ)"
definition normalized:
"normalized M ≡
(∀ i j. 0 < i ∧ i ≤ n ∧ 0 < j ∧ j ≤ n ∧ M i j ≠ ∞ ⟶
Lt (- ((k o v') j)) ≤ M i j ∧ M i j ≤ Le ((k o v') i))
∧ (∀ i ≤ n. i > 0 ⟶ (M i 0 ≤ Le ((k o v') i) ∨ M i 0 = ∞) ∧ Lt (- ((k o v') i)) ≤ M 0 i)"
definition apx_def:
"Approx⇩β Z ≡ ⋂ {S. ∃ U M. S = ⋃ U ∧ U ⊆ ℛ ∧ Z ⊆ S ∧ vabstr S M ∧ normalized M}"
lemma apx_min:
"S = ⋃ U ⟹ U ⊆ ℛ ⟹ S = [M]⇘v,n⇙ ⟹ ∀ i≤n. ∀ j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ
⟹ normalized M ⟹ Z ⊆ S ⟹ Approx⇩β Z ⊆ S"
unfolding apx_def by blast
lemma "U ≠ {} ⟹ x ∈ ⋂ U ⟹ ∃ S ∈ U. x ∈ S" by auto
lemma ℛ_union: "⋃ ℛ = V" using region_cover unfolding V_def ℛ_def by auto
lemma all_dbm: "∃ M. vabstr (⋃ℛ) M ∧ normalized M"
proof -
let ?M = "λ i j. if i = 0 then Le 0 else ∞"
have "[?M]⇘v,n⇙ = V" unfolding V_def DBM_zone_repr_def DBM_val_bounded_def
proof (auto, goal_cases)
case (1 u c)
with clock_numbering have "dbm_entry_val u None (Some c) (Le 0)" by auto
then show ?case by auto
next
case (2 u c)
from clock_numbering(1) have "0 ≠ v c" by auto
with 2 show ?case by auto
next
case (3 u c)
from clock_numbering(1) have "0 ≠ v c" by auto
with 3 show ?case by auto
next
case (4 u c)
with clock_numbering have "c ∈ X" by blast
with 4(1) show ?case by auto
next
case (5 u c1)
from clock_numbering(1) have "0 ≠ v c1" by auto
with 5 show ?case by auto
qed
moreover have "∀ i≤n. ∀ j≤n. ?M i j ≠ ∞ ⟶ get_const (?M i j) ∈ ℤ" by auto
moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def by auto
ultimately show ?thesis using ℛ_union by auto
qed
lemma ℛ_int:
"R ∈ ℛ ⟹ R' ∈ ℛ ⟹ R ≠ R' ⟹ R ∩ R' = {}" using ℛ_regions_distinct by blast
lemma aux1:
"u ∈ R ⟹ R ∈ ℛ ⟹ U ⊆ ℛ ⟹ u ∈ ⋃ U ⟹ R ⊆ ⋃ U" using ℛ_int by blast
lemma aux2: "x ∈ ⋂ U ⟹ U ≠ {} ⟹ ∃ S ∈ U. x ∈ S" by blast
lemma aux2': "x ∈ ⋂ U ⟹ U ≠ {} ⟹ ∀ S ∈ U. x ∈ S" by blast
lemma apx_subset: "Z ⊆ Approx⇩β Z" unfolding apx_def by auto
lemma aux3:
"∀ X ∈ U. ∀ Y ∈ U. X ∩ Y ∈ U ⟹ S ⊆ U ⟹ S ≠ {} ⟹ finite S ⟹ ⋂ S ∈ U"
proof goal_cases
case 1
with finite_list obtain l where "set l = S" by blast
then show ?thesis using 1
proof (induction l arbitrary: S)
case Nil thus ?case by auto
next
case (Cons x xs)
show ?case
proof (cases "set xs = {}")
case False
with Cons have "⋂(set xs) ∈ U" by auto
with Cons.prems(1-3) show ?thesis by force
next
case True
with Cons.prems show ?thesis by auto
qed
qed
qed
lemma empty_zone_dbm:
"∃ M :: t DBM. vabstr {} M ∧ normalized M ∧ (∀k ≤ n. M k k ≤ Le 0)"
proof -
from non_empty obtain c where c: "c ∈ X" by auto
with clock_numbering have c': "v c > 0" "v c ≤ n" by auto
let ?M = "λi j. if i = v c ∧ j = 0 ∨ i = j then Le (0::t) else if i = 0 ∧ j = v c then Lt 0 else ∞"
have "[?M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def DBM_val_bounded_def using c' by auto
moreover have "∀ i≤n. ∀ j≤n. ?M i j ≠ ∞ ⟶ get_const (?M i j) ∈ ℤ" by auto
moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def by auto
ultimately show ?thesis by auto
qed
lemma valid_dbms_int:
"∀X∈{S. ∃M. vabstr S M}. ∀Y∈{S. ∃M. vabstr S M}. X ∩ Y ∈ {S. ∃M. vabstr S M}"
proof (auto, goal_cases)
case (1 M1 M2)
obtain M' where M': "M' = And M1 M2" by fast
from DBM_and_sound1[OF ] DBM_and_sound2[OF] DBM_and_complete[OF ]
have "[M1]⇘v,n⇙ ∩ [M2]⇘v,n⇙ = [M']⇘v,n⇙" unfolding DBM_zone_repr_def M' by auto
moreover from 1 have "∀ i≤n. ∀ j≤n. M' i j ≠ ∞ ⟶ get_const (M' i j) ∈ ℤ"
unfolding M' by (auto split: split_min)
ultimately show ?case by auto
qed
print_statement split_min
lemma split_min':
"P (min i j) = ((min i j = i ⟶ P i) ∧ (min i j = j ⟶ P j))"
unfolding min_def by auto
lemma normalized_and_preservation:
"normalized M1 ⟹ normalized M2 ⟹ normalized (And M1 M2)"
unfolding normalized by safe (subst And.simps, split split_min', fastforce)+
lemma valid_dbms_int':
"∀X∈{S. ∃M. vabstr S M ∧ normalized M}. ∀Y∈{S. ∃M. vabstr S M ∧ normalized M}.
X ∩ Y ∈ {S. ∃M. vabstr S M ∧ normalized M}"
proof (auto, goal_cases)
case (1 M1 M2)
obtain M' where M': "M' = And M1 M2" by fast
from DBM_and_sound1 DBM_and_sound2 DBM_and_complete
have "[M1]⇘v,n⇙ ∩ [M2]⇘v,n⇙ = [M']⇘v,n⇙" unfolding M' DBM_zone_repr_def by auto
moreover from M' 1 have "∀ i≤n. ∀ j≤n. M' i j ≠ ∞ ⟶ get_const (M' i j) ∈ ℤ"
by (auto split: split_min)
moreover from normalized_and_preservation[OF 1(2,4)] have "normalized M'" unfolding M' .
ultimately show ?case by auto
qed
lemma apx_in:
"Z ⊆ V ⟹ Approx⇩β Z ∈ {S. ∃ U M. S = ⋃ U ∧ U ⊆ ℛ ∧ Z ⊆ S ∧ vabstr S M ∧ normalized M}"
proof -
assume "Z ⊆ V"
let ?A = "{S. ∃ U M. S = ⋃ U ∧ U ⊆ ℛ ∧ Z ⊆ S ∧ vabstr S M ∧ normalized M}"
let ?U = "{R ∈ ℛ. ∀ S ∈ ?A. R ⊆ S}"
have "?A ⊆ {S. ∃ U. S = ⋃ U ∧ U ⊆ ℛ}" by auto
moreover from finite_ℛ have "finite …" by auto
ultimately have "finite ?A" by (auto intro: finite_subset)
from all_dbm obtain M where M:
"vabstr (⋃ℛ) M" "normalized M"
by auto
with ‹_ ⊆ V› ℛ_union have "V ∈ ?A" by blast
then have "?A ≠ {}" by blast
have "?A ⊆ {S. ∃ M. vabstr S M ∧ normalized M}" by auto
with aux3[OF valid_dbms_int' this ‹?A ≠ _› ‹finite ?A›] have
"⋂ ?A ∈ {S. ∃ M. vabstr S M ∧ normalized M}"
by blast
then obtain M where *: "vabstr (Approx⇩β Z) M" "normalized M" unfolding apx_def by auto
have "⋃ ?U = ⋂ ?A"
proof (safe, goal_cases)
case 1
show ?case
proof (cases "Z = {}")
case False
then obtain v where "v ∈ Z" by auto
with region_cover ‹Z ⊆ V› obtain R where "R ∈ ℛ" "v ∈ R" unfolding V_def by blast
with aux1[OF this(2,1)] ‹v ∈ Z› have "R ∈ ?U" by blast
with 1 show ?thesis by blast
next
case True
with empty_zone_dbm have "{} ∈ ?A" by auto
with 1(1,3) show ?thesis by blast
qed
next
case (2 v)
from aux2[OF 2 ‹?A ≠ _›] obtain S where "v ∈ S" "S ∈ ?A" by blast
then obtain R where "v ∈ R" "R ∈ ℛ" by auto
{ fix S assume "S ∈ ?A"
with aux2'[OF 2 ‹?A ≠ _›] have "v ∈ S" by auto
with ‹S ∈ ?A› obtain U M R' where *:
"v ∈ R'" "R' ∈ ℛ" "S = ⋃U" "U ⊆ ℛ" "vabstr S M" "Z ⊆ S"
by blast
from aux1[OF this(1,2,4)] *(3) ‹v ∈ S› have "R' ⊆ S" by blast
moreover from ℛ_regions_distinct[OF *(2,1) ‹R ∈ ℛ›] ‹v ∈ R› have "R' = R" by fast
ultimately have "R ⊆ S" by fast
}
with ‹R ∈ ℛ› have "R ∈ ?U" by auto
with ‹v ∈ R› show ?case by auto
qed
then have "Approx⇩β Z = ⋃?U" "?U ⊆ ℛ" "Z ⊆ Approx⇩β Z" unfolding apx_def by auto
with * show ?thesis by blast
qed
lemma apx_empty:
"Approx⇩β {} = {}"
unfolding apx_def using empty_zone_dbm by blast
end
section ‹Computing ‹β›-Approximation›
context Beta_Regions'
begin
lemma dbm_regions:
"vabstr S M ⟹ normalized M ⟹ [M]⇘v,n⇙ ≠ {} ⟹ [M]⇘v,n⇙ ⊆ V ⟹ ∃ U ⊆ ℛ. S = ⋃ U"
proof goal_cases
case A: 1
let ?U =
"{R ∈ ℛ. ∃ I J r. R = region X I J r ∧ valid_region X k I J r ∧
(∀ c ∈ X.
(∀ d. I c = Const d ⟶ M (v c) 0 ≥ Le d ∧ M 0 (v c) ≥ Le (-d)) ∧
(∀ d. I c = Intv d ⟶ M (v c) 0 ≥ Lt (d + 1) ∧ M 0 (v c) ≥ Lt (-d)) ∧
(I c = Greater (k c) ⟶ M (v c) 0 = ∞)
) ∧
(∀ x ∈ X. ∀ y ∈ X.
(∀ c d. I x = Intv c ∧ I y = Intv d ⟶ M (v x) (v y) ≥
(if (x, y) ∈ r then if (y, x) ∈ r then Le (c - d) else Lt (c - d) else Lt (c - d + 1))) ∧
(∀ c d. I x = Intv c ∧ I y = Intv d ⟶ M (v y) (v x) ≥
(if (y, x) ∈ r then if (x, y) ∈ r then Le (d - c) else Lt (d - c) else Lt (d - c + 1))) ∧
(∀ c d. I x = Const c ∧ I y = Const d ⟶ M (v x) (v y) ≥ Le (c - d)) ∧
(∀ c d. I x = Const c ∧ I y = Const d ⟶ M (v y) (v x) ≥ Le (d - c)) ∧
(∀ c d. I x = Intv c ∧ I y = Const d ⟶ M (v x) (v y) ≥ Lt (c - d + 1)) ∧
(∀ c d. I x = Intv c ∧ I y = Const d ⟶ M (v y) (v x) ≥ Lt (d - c)) ∧
(∀ c d. I x = Const c ∧ I y = Intv d ⟶ M (v x) (v y) ≥ Lt (c - d)) ∧
(∀ c d. I x = Const c ∧ I y = Intv d ⟶ M (v y) (v x) ≥ Lt (d - c + 1)) ∧
((isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Greater' (k x) ⟶ M (v x) (v y) = ∞) ∧
(∀ c. (isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Const' c
⟶ M (v x) (v y) ≥ Le c ∧ M (v y) (v x) ≥ Le (- c)) ∧
(∀ c. (isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Intv' c
⟶ M (v x) (v y) ≥ Lt (c + 1) ∧ M (v y) (v x) ≥ Lt (- c))
)
}"
have "⋃ ?U = [M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (standard, goal_cases)
case 1
show ?case
proof (auto, goal_cases)
case 1
from A(3) show "Le 0 ≼ M 0 0" unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
next
case (2 u I J r c)
note B = this
from B(6) clock_numbering have "c ∈ X" by blast
with B(1) v_v' have *: "intv_elem c u (I c)" "v' (v c) = c" by auto
from clock_numbering(1) have "v c > 0" by auto
show ?case
proof (cases "I c")
case (Const d)
with B(4) ‹c ∈ X› have "M 0 (v c) ≥ Le (- real d)" by auto
with * Const show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
next
case (Intv d)
with B(4) ‹c ∈ X› have "M 0 (v c) ≥ Lt (- real d)" by auto
with * Intv show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
next
case (Greater d)
with B(3) ‹c ∈ X› have "I c = Greater (k c)" by fastforce
with * have "- u c < - k c" by auto
moreover from A(2) *(2) ‹v c ≤ n› ‹v c > 0› have
"Lt (- k c) ≤ M 0 (v c)"
unfolding normalized by force
ultimately show ?thesis by - (rule dbm_entry_val_mono_2[folded less_eq], auto)
qed
next
case (3 u I J r c)
note B = this
from B(6) clock_numbering have "c ∈ X" by blast
with B(1) v_v' have *: "intv_elem c u (I c)" "v' (v c) = c" by auto
from clock_numbering(1) have "v c > 0" by auto
show ?case
proof (cases "I c")
case (Const d)
with B(4) ‹c ∈ X› have "M (v c) 0 ≥ Le d" by auto
with * Const show ?thesis by - (rule dbm_entry_val_mono_3[folded less_eq], auto)
next
case (Intv d)
with B(4) ‹c ∈ X› have "M (v c) 0 ≥ Lt (real d + 1)" by auto
with * Intv show ?thesis by - (rule dbm_entry_val_mono_3[folded less_eq], auto)
next
case (Greater d)
with B(3) ‹c ∈ X› have "I c = Greater (k c)" by fastforce
with B(4) ‹c ∈ X› show ?thesis by auto
qed
next
case B: (4 u I J r c1 c2)
from B(6,7) clock_numbering have "c1 ∈ X" "c2 ∈ X" by blast+
with B(1) v_v' have *:
"intv_elem c1 u (I c1)" "intv_elem c2 u (I c2)" "v' (v c1) = c1" "v' (v c2) = c2"
by auto
from clock_numbering(1) have "v c1 > 0" "v c2 > 0" by auto
{ assume C: "isGreater (I c1) ∨ isGreater (I c2)"
with B(1) ‹c1 ∈ X› ‹c2 ∈ X› have **: "intv'_elem c1 c2 u (J c1 c2)" by force
have ?case
proof (cases "J c1 c2")
case (Smaller' c)
with C B(3) ‹c1 ∈ X› ‹c2 ∈ X› have "c ≤ - k c2" by fastforce
moreover from C ‹c1 ∈ X› ‹c2 ∈ X› ** Smaller' have "u c1 - u c2 < c" by auto
moreover from A(2) *(3,4) B(6,7) ‹v c1 > 0› ‹v c2 > 0› have
"M (v c1) (v c2) ≥ Lt (- k c2) ∨ M (v c1) (v c2) = ∞"
unfolding normalized by fastforce
ultimately show ?thesis by (safe) (rule dbm_entry_val_mono_1[folded less_eq], auto)
next
case (Const' c)
with C B(5) ‹c1 ∈ X› ‹c2 ∈ X› have "M (v c1) (v c2) ≥ Le c" by auto
with Const' ** ‹c1 ∈ X› ‹c2 ∈ X› show ?thesis
by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case (Intv' c)
with C B(5) ‹c1 ∈ X› ‹c2 ∈ X› have "M (v c1) (v c2) ≥ Lt (real_of_int c + 1)" by auto
with Intv' ** ‹c1 ∈ X› ‹c2 ∈ X› show ?thesis
by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case (Greater' c)
with C B(3) ‹c1 ∈ X› ‹c2 ∈ X› have "c = k c1" by fastforce
with Greater' C B(5) ‹c1 ∈ X› ‹c2 ∈ X› show ?thesis by auto
qed
} note GreaterI = this
show ?case
proof (cases "I c1")
case (Const c)
show ?thesis
proof (cases "I c2", goal_cases)
case (1 d)
with Const ‹c1 ∈ X› ‹c2 ∈ X› *(1,2) have "u c1 = c" "u c2 = d" by auto
moreover from ‹c1 ∈ X› ‹c2 ∈ X› 1 Const B(5) have
"Le (real c - real d) ≤ M (v c1) (v c2)"
by meson
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case (Intv d)
with Const ‹c1 ∈ X› ‹c2 ∈ X› *(1,2) have "u c1 = c" "d < u c2" by auto
then have "u c1 - u c2 < c - real d" by auto
moreover from Const ‹c1 ∈ X› ‹c2 ∈ X› Intv B(5) have
"Lt (real c - d) ≤ M (v c1) (v c2)"
by meson
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case Greater then show ?thesis by (auto intro: GreaterI)
qed
next
case (Intv c)
show ?thesis
proof (cases "I c2", goal_cases)
case (Const d)
with Intv ‹c1 ∈ X› ‹c2 ∈ X› *(1,2) have "u c1 < c + 1" "d = u c2" by auto
then have "u c1 - u c2 < c - real d + 1" by auto
moreover from ‹c1 ∈ X› ‹c2 ∈ X› Intv Const B(5) have
"Lt (real c - real d + 1) ≤ M (v c1) (v c2)"
by meson
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case (2 d)
show ?case
proof (cases "(c1,c2) ∈ r")
case True
note T = this
show ?thesis
proof (cases "(c2,c1) ∈ r")
case True
with T B(5) 2 Intv ‹c1 ∈ X› ‹c2 ∈ X› have
"Le (real c - real d) ≤ M (v c1) (v c2)"
by auto
moreover from nat_intv_frac_decomp[of c "u c1"] nat_intv_frac_decomp[of d "u c2"]
B(1,2) ‹c1 ∈ X› ‹c2 ∈ X› T True Intv 2 *(1,2)
have "u c1 - u c2 = real c - d" by auto
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
next
case False
with T B(5) 2 Intv ‹c1 ∈ X› ‹c2 ∈ X› have
"Lt (real c - real d) ≤ M (v c1) (v c2)"
by auto
moreover from nat_intv_frac_decomp[of c "u c1"] nat_intv_frac_decomp[of d "u c2"]
B(1,2) ‹c1 ∈ X› ‹c2 ∈ X› T False Intv 2 *(1,2)
have "u c1 - u c2 < real c - d" by auto
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
qed
next
case False
with B(5) 2 Intv ‹c1 ∈ X› ‹c2 ∈ X› have
"Lt (real c - real d + 1) ≤ M (v c1) (v c2)"
by meson
moreover from 2 Intv ‹c1 ∈ X› ‹c2 ∈ X› * have "u c1 - u c2 < c - real d + 1" by auto
ultimately show ?thesis by (auto intro: dbm_entry_val_mono_1[folded less_eq])
qed
next
case Greater then show ?thesis by (auto intro: GreaterI)
qed
next
case Greater then show ?thesis by (auto intro: GreaterI)
qed
qed
next
case 2 show ?case
proof (safe, goal_cases)
case (1 u)
with A(4) have "u ∈ V" unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with region_cover obtain R where "R ∈ ℛ" "u ∈ R" unfolding V_def by auto
then obtain I J r where R: "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
have "(∀c∈X. (∀d. I c = Const d ⟶ Le (real d) ≤ M (v c) 0 ∧ Le (- real d) ≤ M 0 (v c)) ∧
(∀d. I c = Intv d ⟶ Lt (real d + 1) ≤ M (v c) 0 ∧ Lt (- real d) ≤ M 0 (v c)) ∧
(I c = Greater (k c) ⟶ M (v c) 0 = ∞))"
proof safe
fix c assume "c ∈ X"
with R ‹u ∈ R› have *: "intv_elem c u (I c)" by auto
fix d assume **: "I c = Const d"
with * have "u c = d" by fastforce
moreover from ** clock_numbering(3) ‹c ∈ X› 1 have
"dbm_entry_val u (Some c) None (M (v c) 0)"
by auto
ultimately show "Le (real d) ≤ M (v c) 0"
unfolding less_eq dbm_le_def by (cases "M (v c) 0") auto
next
fix c assume "c ∈ X"
with R ‹u ∈ R› have *: "intv_elem c u (I c)" by auto
fix d assume **: "I c = Const d"
with * have "u c = d" by fastforce
moreover from ** clock_numbering(3) ‹c ∈ X› 1 have
"dbm_entry_val u None (Some c) (M 0 (v c))"
by auto
ultimately show "Le (- real d) ≤ M 0 (v c)"
unfolding less_eq dbm_le_def by (cases "M 0 (v c)") auto
next
fix c assume "c ∈ X"
with R ‹u ∈ R› have *: "intv_elem c u (I c)" by auto
fix d assume **: "I c = Intv d"
with * have "d < u c" "u c < d + 1" by fastforce+
moreover from ** clock_numbering(3) ‹c ∈ X› 1 have
"dbm_entry_val u (Some c) None (M (v c) 0)"
by auto
moreover have
"M (v c) 0 ≠ ∞ ⟹ get_const (M (v c) 0) ∈ ℤ"
using ‹c ∈ X› clock_numbering A(1) by auto
ultimately show "Lt (real d + 1) ≤ M (v c) 0" unfolding less_eq dbm_le_def
apply (cases "M (v c) 0")
apply auto
apply (rename_tac x1)
apply (subgoal_tac "x1 > d")
apply (rule dbm_lt.intros(5))
apply (metis nat_intv_frac_gt0 frac_eq_0_iff less_irrefl linorder_not_le of_nat_1 of_nat_add)
apply simp
apply (rename_tac x2)
apply (subgoal_tac "x2 > d + 1")
apply (rule dbm_lt.intros(6))
apply (metis of_nat_1 of_nat_add)
apply simp
by (metis nat_intv_not_int One_nat_def add.commute add.right_neutral add_Suc_right le_less_trans
less_eq_real_def linorder_neqE_linordered_idom semiring_1_class.of_nat_simps(2))
next
fix c assume "c ∈ X"
with R ‹u ∈ R› have *: "intv_elem c u (I c)" by auto
fix d assume **: "I c = Intv d"
with * have "d < u c" "u c < d + 1" by fastforce+
moreover from ** clock_numbering(3) ‹c ∈ X› 1 have
"dbm_entry_val u None (Some c) (M 0 (v c))"
by auto
moreover have "M 0 (v c) ≠ ∞ ⟹ get_const (M 0 (v c)) ∈ ℤ" using ‹c ∈ X› clock_numbering A(1) by auto
ultimately show "Lt (- real d) ≤ M 0 (v c)" unfolding less_eq dbm_le_def
proof (cases "M 0 (v c)", -, auto, goal_cases)
case prems: (1 x1)
then have "u c = d + frac (u c)" by (metis nat_intv_frac_decomp ‹u c < d + 1›)
with prems(5) have "- x1 ≤ d + frac (u c)" by auto
with prems(1) frac_ge_0 frac_lt_1 have "- x1 ≤ d"
by - (rule ints_le_add_frac2[of "frac (u c)" d "-x1"]; fastforce)
with prems have "- d ≤ x1" by auto
then show ?case by auto
next
case prems: (2 x1)
then have "u c = d + frac (u c)" by (metis nat_intv_frac_decomp ‹u c < d + 1›)
with prems(5) have "- x1 ≤ d + frac (u c)" by auto
with prems(1) frac_ge_0 frac_lt_1 have "- x1 ≤ d"
by - (rule ints_le_add_frac2[of "frac (u c)" d "-x1"]; fastforce)
with prems(6) have "- d < x1" by auto
then show ?case by auto
qed
next
fix c assume "c ∈ X"
with R ‹u ∈ R› have *: "intv_elem c u (I c)" by auto
fix d assume **: "I c = Greater (k c)"
have "M (v c) 0 ≤ Le ((k o v') (v c)) ∨ M (v c) 0 = ∞"
using A(2) ‹c ∈ X› clock_numbering unfolding normalized by auto
with v_v' ‹c ∈ X› have "M (v c) 0 ≤ Le (k c) ∨ M (v c) 0 = ∞" by auto
moreover from * ** have "k c < u c" by fastforce
moreover from ** clock_numbering(3) ‹c ∈ X› 1 have
"dbm_entry_val u (Some c) None (M (v c) 0)"
by auto
moreover have
"M (v c) 0 ≠ ∞ ⟹ get_const (M (v c) 0) ∈ ℤ"
using ‹c ∈ X› clock_numbering A(1) by auto
ultimately show "M (v c) 0 = ∞" unfolding less_eq dbm_le_def
apply -
apply (rule ccontr)
using ** apply (cases "M (v c) 0")
by auto
qed
moreover
{ fix x y assume X: "x ∈ X" "y ∈ X"
with R ‹u ∈ R› have *: "intv_elem x u (I x)" "intv_elem y u (I y)" by auto
from X R ‹u ∈ R› have **:
"isGreater (I x) ∨ isGreater (I y) ⟶ intv'_elem x y u (J x y)"
by force
have int: "M (v x) (v y) ≠ ∞ ⟹ get_const (M (v x) (v y)) ∈ ℤ" using X clock_numbering A(1)
by auto
have int2: "M (v y) (v x) ≠ ∞ ⟹ get_const (M (v y) (v x)) ∈ ℤ" using X clock_numbering A(1)
by auto
from 1 clock_numbering(3) X 1 have ***:
"dbm_entry_val u (Some x) (Some y) (M (v x) (v y))"
"dbm_entry_val u (Some y) (Some x) (M (v y) (v x))"
by auto
have
"(∀ c d. I x = Intv c ∧ I y = Intv d ⟶ M (v x) (v y) ≥
(if (x, y) ∈ r then if (y, x) ∈ r then Le (c - d) else Lt (c - d) else Lt (c - d + 1))) ∧
(∀ c d. I x = Intv c ∧ I y = Intv d ⟶ M (v y) (v x) ≥
(if (y, x) ∈ r then if (x, y) ∈ r then Le (d - c) else Lt (d - c) else Lt (d - c + 1))) ∧
(∀ c d. I x = Const c ∧ I y = Const d ⟶ M (v x) (v y) ≥ Le (c - d)) ∧
(∀ c d. I x = Const c ∧ I y = Const d ⟶ M (v y) (v x) ≥ Le (d - c)) ∧
(∀ c d. I x = Intv c ∧ I y = Const d ⟶ M (v x) (v y) ≥ Lt (c - d + 1)) ∧
(∀ c d. I x = Intv c ∧ I y = Const d ⟶ M (v y) (v x) ≥ Lt (d - c)) ∧
(∀ c d. I x = Const c ∧ I y = Intv d ⟶ M (v x) (v y) ≥ Lt (c - d)) ∧
(∀ c d. I x = Const c ∧ I y = Intv d ⟶ M (v y) (v x) ≥ Lt (d - c + 1)) ∧
((isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Greater' (k x) ⟶ M (v x) (v y) = ∞) ∧
(∀ c. (isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Const' c
⟶ M (v x) (v y) ≥ Le c ∧ M (v y) (v x) ≥ Le (- c)) ∧
(∀ c. (isGreater (I x) ∨ isGreater (I y)) ∧ J x y = Intv' c
⟶ M (v x) (v y) ≥ Lt (c + 1) ∧ M (v y) (v x) ≥ Lt (- c))"
proof (auto, goal_cases)
case **: (1 c d)
with R ‹u ∈ R› X have "frac (u x) = frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"u x - u y = real c - d"
by auto
with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)") auto
next
case **: (2 c d)
with R ‹u ∈ R› X have "frac (u x) > frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real c - d < u x - u y" "u x - u y < real c - d + 1"
by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case **: (3 c d)
from ** R ‹u ∈ R› X have "frac (u x) < frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real c - d - 1 < u x - u y" "u x - u y < real c - d"
by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (4 c d) with R(1) ‹u ∈ R› X show ?case by auto
next
case **: (5 c d)
with R ‹u ∈ R› X have "frac (u x) = frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"u x - u y = real c - d" by auto
with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)") auto
next
case **: (6 c d)
from ** R ‹u ∈ R› X have "frac (u x) < frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real d - c < u y - u x" "u y - u x < real d - c + 1"
by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case **: (7 c d)
from ** R ‹u ∈ R› X have "frac (u x) > frac (u y)" by auto
with * ** nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real d - c - 1 < u y - u x" "u y - u x < real d - c"
by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (8 c d) with R(1) ‹u ∈ R› X show ?case by auto
next
case (9 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"u x - u y = real c - d" by auto
with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)") auto
next
case (10 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"u x - u y = real c - d"
by auto
with *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)") auto
next
case (11 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real c - d < u x - u y"
by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (12 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real d - c - 1 < u y - u x"
by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (13 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real c - d - 1 < u x - u y"
by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (14 c d)
with * nat_intv_frac_decomp[of c "u x"] nat_intv_frac_decomp[of d "u y"] have
"real d - c < u y - u x"
by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (15 d)
have "M (v x) (v y) ≤ Le ((k o v') (v x)) ∨ M (v x) (v y) = ∞"
using A(2) X clock_numbering unfolding normalized by auto
with v_v' X have "M (v x) (v y) ≤ Le (k x) ∨ M (v x) (v y) = ∞" by auto
moreover from 15 * ** have "u x - u y > k x" by auto
ultimately show ?case unfolding less_eq dbm_le_def using *** by (cases "M (v x) (v y)", auto)
next
case (16 d)
have "M (v x) (v y) ≤ Le ((k o v') (v x)) ∨ M (v x) (v y) = ∞"
using A(2) X clock_numbering unfolding normalized by auto
with v_v' X have "M (v x) (v y) ≤ Le (k x) ∨ M (v x) (v y) = ∞" by auto
moreover from 16 * ** have "u x - u y > k x" by auto
ultimately show ?case unfolding less_eq dbm_le_def using *** by (cases "M (v x) (v y)", auto)
next
case 17 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)", auto)
next
case 18 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)", auto)
next
case 19 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v x) (v y)", auto)
next
case 20 with ** *** show ?case unfolding less_eq dbm_le_def by (cases "M (v y) (v x)", auto)
next
case (21 c d)
with ** have "c < u x - u y" by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (22 c d)
with ** have "u x - u y < c + 1" by auto
then have "u y - u x > - c - 1" by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (23 c d)
with ** have "c < u x - u y" by auto
with *** int show ?case unfolding less_eq dbm_le_def
by (cases "M (v x) (v y)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
next
case (24 c d)
with ** have "u x - u y < c + 1" by auto
then have "u y - u x > - c - 1" by auto
with *** int2 show ?case unfolding less_eq dbm_le_def
by (cases "M (v y) (v x)", auto) (fastforce intro: int_lt_Suc_le int_lt_neq_prev_lt)+
qed
}
ultimately show ?case using R ‹u ∈ R› ‹R ∈ ℛ›
apply -
apply standard
apply standard
apply rule
apply assumption
apply (rule exI[where x = I], rule exI[where x = J], rule exI[where x = r])
by auto
qed
qed
with A have "S = ⋃?U" by auto
moreover have "?U ⊆ ℛ" by blast
ultimately show ?case by blast
qed
lemma dbm_regions':
"vabstr S M ⟹ normalized M ⟹ S ⊆ V ⟹ ∃ U ⊆ ℛ. S = ⋃ U"
using dbm_regions by (cases "S = {}") auto
lemma dbm_regions'':
"dbm_int M n ⟹ normalized M ⟹ [M]⇘v,n⇙ ⊆ V ⟹ ∃ U ⊆ ℛ. [M]⇘v,n⇙ = ⋃ U"
using dbm_regions' by auto
lemma canonical_saturated_1:
assumes "Le r ≤ M (v c1) 0"
and "Le (- r) ≤ M 0 (v c1)"
and "cycle_free M n"
and "canonical M n"
and "v c1 ≤ n"
and "v c1 > 0"
and "∀c. v c ≤ n ⟶ 0 < v c"
obtains u where "u ∈ [M]⇘v,n⇙" "u c1 = r"
proof -
let ?M' = "λi' j'. if i'=v c1 ∧ j'=0 then Le r else if i'=0 ∧ j'=v c1 then Le (- r) else M i' j'"
from fix_index'[OF assms(1-5)] assms(6) have M':
"∀u. DBM_val_bounded v u ?M' n ⟶ DBM_val_bounded v u M n"
"cycle_free ?M' n" "?M' (v c1) 0 = Le r" "?M' 0 (v c1) = Le (- r)"
by auto
with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms(7) obtain u where
u: "DBM_val_bounded v u ?M' n"
by fastforce
with assms(5,6) M'(3,4) have "u c1 = r" unfolding DBM_val_bounded_def by fastforce
moreover from u M'(1) have "u ∈ [M]⇘v,n⇙" unfolding DBM_zone_repr_def by auto
ultimately show thesis by (auto intro: that)
qed
lemma canonical_saturated_2:
assumes "Le r ≤ M 0 (v c2)"
and "Le (- r) ≤ M (v c2) 0"
and "cycle_free M n"
and "canonical M n"
and "v c2 ≤ n"
and "v c2 > 0"
and "∀c. v c ≤ n ⟶ 0 < v c"
obtains u where "u ∈ [M]⇘v,n⇙" "u c2 = - r"
proof -
let ?M' = "λi' j'. if i'=0 ∧ j'=v c2 then Le r else if i'=v c2 ∧ j'=0 then Le (-r) else M i' j'"
from fix_index'[OF assms(1-4)] assms(5,6) have M':
"∀u. DBM_val_bounded v u ?M' n ⟶ DBM_val_bounded v u M n"
"cycle_free ?M' n" "?M' 0 (v c2) = Le r" "?M' (v c2) 0 = Le (- r)"
by auto
with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms(7) obtain u where
u: "DBM_val_bounded v u ?M' n"
by fastforce
with assms(5,6) M'(3,4) have "u c2 ≤ -r" "- u c2 ≤ r" unfolding DBM_val_bounded_def by fastforce+
then have "u c2 = -r" by (simp add: le_minus_iff)
moreover from u M'(1) have "u ∈ [M]⇘v,n⇙" unfolding DBM_zone_repr_def by auto
ultimately show thesis by (auto intro: that)
qed
lemma canonical_saturated_3:
assumes "Le r ≤ M (v c1) (v c2)"
and "Le (- r) ≤ M (v c2) (v c1)"
and "cycle_free M n"
and "canonical M n"
and "v c1 ≤ n" "v c2 ≤ n"
and "v c1 ≠ v c2"
and "∀c. v c ≤ n ⟶ 0 < v c"
obtains u where "u ∈ [M]⇘v,n⇙" "u c1 - u c2 = r"
proof -
let ?M'="λi' j'. if i'=v c1 ∧ j'=v c2 then Le r else if i'=v c2 ∧ j'=v c1 then Le (-r) else M i' j'"
from fix_index'[OF assms(1-7), of v] assms(7,8) have M':
"∀u. DBM_val_bounded v u ?M' n ⟶ DBM_val_bounded v u M n"
"cycle_free ?M' n" "?M' (v c1) (v c2) = Le r" "?M' (v c2) (v c1) = Le (- r)"
by auto
with cyc_free_obtains_valuation[unfolded cycle_free_diag_equiv, of ?M' n v] assms obtain u where u:
"DBM_val_bounded v u ?M' n"
by fastforce
with assms(5,6) M'(3,4) have
"u c1 - u c2 ≤ r" "u c2 - u c1 ≤ - r"
unfolding DBM_val_bounded_def by fastforce+
then have "u c1 - u c2 = r" by (simp add: le_minus_iff)
moreover from u M'(1) have "u ∈ [M]⇘v,n⇙" unfolding DBM_zone_repr_def by auto
ultimately show thesis by (auto intro: that)
qed
lemma DBM_canonical_subset_le:
notes any_le_inf[intro]
fixes M :: "t DBM"
assumes "canonical M n" "[M]⇘v,n⇙ ⊆ [M']⇘v,n⇙" "[M]⇘v,n⇙ ≠ {}" "i ≤ n" "j ≤ n" "i ≠ j"
shows "M i j ≤ M' i j"
proof -
from non_empty_cycle_free[OF assms(3)] clock_numbering(2) have "cycle_free M n" by auto
with assms(1,4,5) have non_neg:
"M i j + M j i ≥ Le 0"
by (metis cycle_free_diag order.trans neutral)
from clock_numbering have cn: "∀c. v c ≤ n ⟶ 0 < v c" by auto
show ?thesis
proof (cases "i = 0")
case True
show ?thesis
proof (cases "j = 0")
case True
with assms ‹i = 0› show ?thesis
unfolding neutral DBM_zone_repr_def DBM_val_bounded_def less_eq by auto
next
case False
then have "j > 0" by auto
with ‹j ≤ n› clock_numbering obtain c2 where c2: "v c2 = j" by auto
note t = canonical_saturated_2[OF _ _ ‹cycle_free M n› assms(1) assms(5)[folded c2] _ cn,unfolded c2]
show ?thesis
proof (rule ccontr, goal_cases)
case 1
{ fix d assume 1: "M 0 j = ∞"
obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "d < r"
proof (cases "M j 0")
case (Le d')
obtain r where "r > - d'" using gt_ex by blast
with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case (Lt d')
obtain r where "r > - d'" using gt_ex by blast
with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case INF
with 1 show ?thesis by (intro that[of "d + 1"]) auto
qed
then have "∃ r. Le r ≤ M 0 j ∧ Le (-r) ≤ M j 0 ∧ d < r" by auto
} note inf_case = this
{ fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
then have *: "b > -d" by auto
obtain r where "r > - d" "r > a" "r < b"
proof (cases "a ≥ - d")
case True
from 1 obtain r where "r > a" "r < b" using dense by auto
with True show ?thesis by (auto intro: that[of r])
next
case False
with * obtain r where "r > -d" "r < b" using dense by auto
with False show ?thesis by (auto intro: that[of r])
qed
then have "∃ r. r > -d ∧ r > a ∧ r < b" by auto
} note gt_case = this
{ fix a r assume r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "a < r" "M' 0 j = Le a ∨ M' 0 j = Lt a"
from t[OF this(1,2) ‹0 < j›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c2 = - r" .
with ‹j ≤ n› c2 assms(2) have "dbm_entry_val u None (Some c2) (M' 0 j)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3,4) have False by auto
} note contr = this
from 1 True have "M' 0 j < M 0 j" by auto
then show False unfolding less
proof (cases rule: dbm_lt.cases)
case (1 d)
with inf_case obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "d < r" by auto
from contr[OF this] 1 show False by fast
next
case (2 d)
with inf_case obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "d < r" by auto
from contr[OF this] 2 show False by fast
next
case (3 a b)
obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "a < r"
proof (cases "M j 0")
case (Le d')
with 3 non_neg ‹i = 0› have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 3 obtain r where "r ≥ - d'" "r > a" "r ≤ b" by blast
with Le 3 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 3 non_neg ‹i = 0› have "b + d' > 0" unfolding mult by auto
from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r ≤ b" by auto
with Lt 3 show ?thesis by (intro that[of r]) auto
next
case INF
with 3 show ?thesis by (intro that[of b]) auto
qed
from contr[OF this] 3 show False by fast
next
case (4 a b)
obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "a < r"
proof (cases "M j 0")
case (Le d)
with 4 non_neg ‹i = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 4 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 4 non_neg ‹i = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 4 show ?thesis by (intro that[of r]) auto
next
case INF
from 4 dense obtain r where "r > a" "r < b" by auto
with 4 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 4 show False by fast
next
case (5 a b)
obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "a ≤ r"
proof (cases "M j 0")
case (Le d')
with 5 non_neg ‹i = 0› have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 5 obtain r where "r ≥ - d'" "r ≥ a" "r ≤ b" by blast
with Le 5 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 5 non_neg ‹i = 0› have "b + d' > 0" unfolding mult by auto
then have "b > - d'" by auto
with 5 obtain r where "r > - d'" "r ≥ a" "r ≤ b" by blast
with Lt 5 show ?thesis by (intro that[of r]) auto
next
case INF
with 5 show ?thesis by (intro that[of b]) auto
qed
from t[OF this(1,2) ‹j > 0›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c2 = - r" .
with ‹j ≤ n› c2 assms(2) have "dbm_entry_val u None (Some c2) (M' 0 j)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3) 5 show False by auto
next
case (6 a b)
obtain r where r: "Le r ≤ M 0 j" "Le (-r) ≤ M j 0" "a < r"
proof (cases "M j 0")
case (Le d)
with 6 non_neg ‹i = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 6 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 6 non_neg ‹i = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 6 show ?thesis by (intro that[of r]) auto
next
case INF
from 6 dense obtain r where "r > a" "r < b" by auto
with 6 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 6 show False by fast
qed
qed
qed
next
case False
then have "i > 0" by auto
with ‹i ≤ n› clock_numbering obtain c1 where c1: "v c1 = i" by auto
show ?thesis
proof (cases "j = 0")
case True
note t = canonical_saturated_1[OF _ _ ‹cycle_free M n› assms(1) assms(4)[folded c1] _ cn,
unfolded c1]
show ?thesis
proof (rule ccontr, goal_cases)
case 1
{ fix d assume 1: "M i 0 = ∞"
obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "d < r"
proof (cases "M 0 i")
case (Le d')
obtain r where "r > - d'" using gt_ex by blast
with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case (Lt d')
obtain r where "r > - d'" using gt_ex by blast
with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case INF
with 1 show ?thesis by (intro that[of "d + 1"]) auto
qed
then have "∃ r. Le r ≤ M i 0 ∧ Le (-r) ≤ M 0 i ∧ d < r" by auto
} note inf_case = this
{ fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
then have *: "b > -d" by auto
obtain r where "r > - d" "r > a" "r < b"
proof (cases "a ≥ - d")
case True
from 1 obtain r where "r > a" "r < b" using dense by auto
with True show ?thesis by (auto intro: that[of r])
next
case False
with * obtain r where "r > -d" "r < b" using dense by auto
with False show ?thesis by (auto intro: that[of r])
qed
then have "∃ r. r > -d ∧ r > a ∧ r < b" by auto
} note gt_case = this
{ fix a r assume r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "a < r" "M' i 0 = Le a ∨ M' i 0 = Lt a"
from t[OF this(1,2) ‹i > 0›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c1 = r" .
with ‹i ≤ n› c1 assms(2) have "dbm_entry_val u (Some c1) None (M' i 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3,4) have False by auto
} note contr = this
from 1 True have "M' i 0 < M i 0" by auto
then show False unfolding less
proof (cases rule: dbm_lt.cases)
case (1 d)
with inf_case obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "d < r" by auto
from contr[OF this] 1 show False by fast
next
case (2 d)
with inf_case obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "d < r" by auto
from contr[OF this] 2 show False by fast
next
case (3 a b)
obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "a < r"
proof (cases "M 0 i")
case (Le d')
with 3 non_neg ‹j = 0› have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 3 obtain r where "r ≥ - d'" "r > a" "r ≤ b" by blast
with Le 3 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 3 non_neg ‹j = 0› have "b + d' > 0" unfolding mult by auto
from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r ≤ b" by auto
with Lt 3 show ?thesis by (intro that[of r]) auto
next
case INF
with 3 show ?thesis by (intro that[of b]) auto
qed
from contr[OF this] 3 show False by fast
next
case (4 a b)
obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "a < r"
proof (cases "M 0 i")
case (Le d)
with 4 non_neg ‹j = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 4 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 4 non_neg ‹j = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 4 show ?thesis by (intro that[of r]) auto
next
case INF
from 4 dense obtain r where "r > a" "r < b" by auto
with 4 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 4 show False by fast
next
case (5 a b)
obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "a ≤ r"
proof (cases "M 0 i")
case (Le d')
with 5 non_neg ‹j = 0› have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 5 obtain r where "r ≥ - d'" "r ≥ a" "r ≤ b" by blast
with Le 5 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 5 non_neg ‹j = 0› have "b + d' > 0" unfolding mult by auto
then have "b > - d'" by auto
with 5 obtain r where "r > - d'" "r ≥ a" "r ≤ b" by blast
with Lt 5 show ?thesis by (intro that[of r]) auto
next
case INF
with 5 show ?thesis by (intro that[of b]) auto
qed
from t[OF this(1,2) ‹i > 0›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c1 = r" .
with ‹i ≤ n› c1 assms(2) have "dbm_entry_val u (Some c1) None (M' i 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3) 5 show False by auto
next
case (6 a b)
obtain r where r: "Le r ≤ M i 0" "Le (-r) ≤ M 0 i" "a < r"
proof (cases "M 0 i")
case (Le d)
with 6 non_neg ‹j = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 6 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 6 non_neg ‹j = 0› have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 6 show ?thesis by (intro that[of r]) auto
next
case INF
from 6 dense obtain r where "r > a" "r < b" by auto
with 6 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 6 show False by fast
qed
qed
next
case False
then have "j > 0" by auto
with ‹j ≤ n› clock_numbering obtain c2 where c2: "v c2 = j" by auto
note t = canonical_saturated_3[OF _ _ ‹cycle_free M n› assms(1) assms(4)[folded c1]
assms(5)[folded c2] _ cn, unfolded c1 c2]
show ?thesis
proof (rule ccontr, goal_cases)
case 1
{ fix d assume 1: "M i j = ∞"
obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "d < r"
proof (cases "M j i")
case (Le d')
obtain r where "r > - d'" using gt_ex by blast
with Le 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case (Lt d')
obtain r where "r > - d'" using gt_ex by blast
with Lt 1 show ?thesis by (intro that[of "max r (d + 1)"]) auto
next
case INF
with 1 show ?thesis by (intro that[of "d + 1"]) auto
qed
then have "∃ r. Le r ≤ M i j ∧ Le (-r) ≤ M j i ∧ d < r" by auto
} note inf_case = this
{ fix a b d :: real assume 1: "a < b" assume b: "b + d > 0"
then have *: "b > -d" by auto
obtain r where "r > - d" "r > a" "r < b"
proof (cases "a ≥ - d")
case True
from 1 obtain r where "r > a" "r < b" using dense by auto
with True show ?thesis by (auto intro: that[of r])
next
case False
with * obtain r where "r > -d" "r < b" using dense by auto
with False show ?thesis by (auto intro: that[of r])
qed
then have "∃ r. r > -d ∧ r > a ∧ r < b" by auto
} note gt_case = this
{ fix a r assume r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "a < r" "M' i j = Le a ∨ M' i j = Lt a"
from t[OF this(1,2) ‹i ≠ j›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c1 - u c2 = r" .
with ‹i ≤ n› ‹j ≤ n› c1 c2 assms(2) have "dbm_entry_val u (Some c1) (Some c2) (M' i j)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3,4) have False by auto
} note contr = this
from 1 have "M' i j < M i j" by auto
then show False unfolding less
proof (cases rule: dbm_lt.cases)
case (1 d)
with inf_case obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "d < r" by auto
from contr[OF this] 1 show False by fast
next
case (2 d)
with inf_case obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "d < r" by auto
from contr[OF this] 2 show False by fast
next
case (3 a b)
obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "a < r"
proof (cases "M j i")
case (Le d')
with 3 non_neg have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 3 obtain r where "r ≥ - d'" "r > a" "r ≤ b" by blast
with Le 3 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 3 non_neg have "b + d' > 0" unfolding mult by auto
from gt_case[OF 3(3) this] obtain r where "r > - d'" "r > a" "r ≤ b" by auto
with Lt 3 show ?thesis by (intro that[of r]) auto
next
case INF
with 3 show ?thesis by (intro that[of b]) auto
qed
from contr[OF this] 3 show False by fast
next
case (4 a b)
obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "a < r"
proof (cases "M j i")
case (Le d)
with 4 non_neg have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 4 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 4 non_neg have "b + d > 0" unfolding mult by auto
from gt_case[OF 4(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 4 show ?thesis by (intro that[of r]) auto
next
case INF
from 4 dense obtain r where "r > a" "r < b" by auto
with 4 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 4 show False by fast
next
case (5 a b)
obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "a ≤ r"
proof (cases "M j i")
case (Le d')
with 5 non_neg have "b + d' ≥ 0" unfolding mult by auto
then have "b ≥ - d'" by auto
with 5 obtain r where "r ≥ - d'" "r ≥ a" "r ≤ b" by blast
with Le 5 show ?thesis by (intro that[of r]) auto
next
case (Lt d')
with 5 non_neg have "b + d' > 0" unfolding mult by auto
then have "b > - d'" by auto
with 5 obtain r where "r > - d'" "r ≥ a" "r ≤ b" by blast
with Lt 5 show ?thesis by (intro that[of r]) auto
next
case INF
with 5 show ?thesis by (intro that[of b]) auto
qed
from t[OF this(1,2) ‹i ≠ j›] obtain u where u: "u ∈ [M]⇘v,n⇙" "u c1 - u c2= r" .
with ‹i ≤ n› ‹j ≤ n› c1 c2 assms(2) have "dbm_entry_val u (Some c1) (Some c2) (M' i j)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by blast
with u(2) r(3) 5 show False by auto
next
case (6 a b)
obtain r where r: "Le r ≤ M i j" "Le (-r) ≤ M j i" "a < r"
proof (cases "M j i")
case (Le d)
with 6 non_neg have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Le 6 show ?thesis by (intro that[of r]) auto
next
case (Lt d)
with 6 non_neg have "b + d > 0" unfolding mult by auto
from gt_case[OF 6(3) this] obtain r where "r > - d" "r > a" "r < b" by auto
with Lt 6 show ?thesis by (intro that[of r]) auto
next
case INF
from 6 dense obtain r where "r > a" "r < b" by auto
with 6 INF show ?thesis by (intro that[of r]) auto
qed
from contr[OF this] 6 show False by fast
qed
qed
qed
qed
qed
lemma DBM_set_diag:
assumes "[M]⇘v,n⇙ ≠ {}"
shows "[M]⇘v,n⇙ = [(λ i j. if i = j then Le 0 else M i j)]⇘v,n⇙"
using non_empty_dbm_diag_set[OF clock_numbering(1) assms] unfolding neutral by auto
lemma DBM_le_subset':
assumes "∀i ≤ n. ∀ j ≤ n. i ≠ j ⟶ M i j ≤ M' i j"
and "∀ i≤n. M' i i ≥ Le 0"
and "u ∈ [M]⇘v,n⇙"
shows "u ∈ [M']⇘v,n⇙"
proof -
let ?M = "λ i j. if i = j then Le 0 else M i j"
have "∀i j. i ≤ n ⟶ j ≤ n ⟶ ?M i j ≤ M' i j" using assms(1,2) by auto
moreover from DBM_set_diag assms(3) have "u ∈ [?M]⇘v,n⇙" by auto
ultimately show ?thesis using DBM_le_subset[folded less_eq, of n ?M M' u v] by auto
qed
lemma neg_diag_empty_spec:
assumes "i ≤ n" "M i i < 𝟭"
shows "[M]⇘v,n⇙ = {}"
using assms neg_diag_empty[where v= v and M = M, OF _ assms] clock_numbering(2) by auto
lemma canonical_empty_zone_spec:
assumes "canonical M n"
shows "[M]⇘v,n⇙ = {} ⟷ (∃i≤n. M i i < 𝟭)"
using canonical_empty_zone[of n v M, OF _ _ assms] clock_numbering by auto
lemma norm_set_diag:
assumes "canonical M n" "[M]⇘v,n⇙ ≠ {}"
obtains M' where "[M]⇘v,n⇙ = [M']⇘v,n⇙" "[norm M (k o v') n]⇘v,n⇙ = [norm M' (k o v') n]⇘v,n⇙"
"∀ i ≤ n. M' i i = 𝟭" "canonical M' n"
proof -
from assms(2) neg_diag_empty_spec have *: "∀ i≤n. M i i ≥ Le 0" unfolding neutral by force
let ?M = "λi j. if i = j then Le 0 else M i j"
let ?NM = "norm M (k o v') n"
let ?M2 = "λi j. if i = j then Le 0 else ?NM i j"
from assms have "[?NM]⇘v,n⇙ ≠ {}"
by (metis Collect_empty_eq norm_mono DBM_zone_repr_def clock_numbering(1) mem_Collect_eq)
from DBM_set_diag[OF this] DBM_set_diag[OF assms(2)] have
"[M]⇘v,n⇙ = [?M]⇘v,n⇙" "[?NM]⇘v,n⇙ = [?M2]⇘v,n⇙"
by auto
moreover have "norm ?M (k o v') n = ?M2" unfolding norm_def by fastforce
moreover have "∀ i ≤ n. ?M i i = 𝟭" unfolding neutral by auto
moreover have "canonical ?M n" using assms(1) *
unfolding neutral[symmetric] less_eq[symmetric] mult[symmetric] by fastforce
ultimately show ?thesis by (auto intro: that)
qed
lemma norm_normalizes:
notes any_le_inf[intro]
shows "normalized (norm M (k o v') n)"
unfolding normalized
proof (safe, goal_cases)
case (1 i j)
show ?case
proof (cases "M i j < Lt (- real (k (v' j)))")
case True with 1 show ?thesis unfolding norm_def less by (auto simp: Let_def)
next
case False
with 1 show ?thesis unfolding norm_def by (auto simp: Let_def)
qed
next
case (2 i j)
have **: "- real ((k o v') j) ≤ (k o v') i" by simp
then have *: "Lt (- k (v' j)) < Le (k (v' i))" by (auto intro: Lt_lt_LeI)
show ?case
proof (cases "M i j ≤ Le (real (k (v' i)))")
case False with 2 show ?thesis unfolding norm_def less_eq dbm_le_def by (auto simp: Let_def)
next
case True with 2 show ?thesis unfolding norm_def by (auto simp: Let_def)
qed
next
case (3 i)
show ?case
proof (cases "M i 0 ≤ Le (real (k (v' i)))")
case False then have "Le (real (k (v' i))) ≺ M i 0" unfolding less_eq dbm_le_def by auto
with 3 show ?thesis unfolding norm_def by auto
next
case True
with 3 show ?thesis unfolding norm_def less_eq dbm_le_def by (auto simp: Let_def)
qed
next
case (4 i)
show ?case
proof (cases "M 0 i < Lt (- real (k (v' i)))")
case True with 4 show ?thesis unfolding norm_def less by auto
next
case False with 4 show ?thesis unfolding norm_def by (auto simp: Let_def)
qed
qed
lemma norm_int_preservation:
assumes "dbm_int M n" "i ≤ n" "j ≤ n" "norm M (k o v') n i j ≠ ∞"
shows "get_const (norm M (k o v') n i j) ∈ ℤ"
using assms unfolding norm_def by (auto simp: Let_def)
lemma norm_V_preservation':
notes any_le_inf[intro]
assumes "[M]⇘v,n⇙ ⊆ V" "canonical M n" "[M]⇘v,n⇙ ≠ {}"
shows "[norm M (k o v') n]⇘v,n⇙ ⊆ V"
proof -
let ?M = "norm M (k o v') n"
from non_empty_cycle_free[OF assms(3)] clock_numbering(2) have *: "cycle_free M n" by auto
{ fix c assume "c ∈ X"
with clock_numbering have c: "c ∈ X" "v c > 0" "v c ≤ n" by auto
with assms(2) have
"M 0 (v c) + M (v c) 0 ≥ M 0 0"
unfolding mult less_eq by blast
moreover from cycle_free_diag[OF *] have "M 0 0 ≥ Le 0" unfolding neutral by auto
ultimately have ge_0: "M 0 (v c) + M (v c) 0 ≥ Le 0" by auto
have "M 0 (v c) ≤ Le 0"
proof (cases "M 0 (v c)")
case (Le d)
with ge_0 have "M (v c) 0 ≥ Le (-d)"
apply (cases "M (v c) 0")
unfolding mult apply auto
apply (rename_tac x1)
apply (subgoal_tac "-d ≤ x1")
apply auto
apply (rename_tac x2)
apply (subgoal_tac "-d < x2")
by auto
with Le canonical_saturated_2[OF _ _ ‹cycle_free M n› assms(2) c(3)] clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = -d" by auto
with assms(1) c(1) Le show ?thesis unfolding V_def by fastforce
next
case (Lt d)
show ?thesis
proof (cases "d ≤ 0")
case True
then have "Lt d < Le 0" by (auto intro: Lt_lt_LeI)
with Lt show ?thesis by auto
next
case False
then have "d > 0" by auto
note Lt' = Lt
show ?thesis
proof (cases "M (v c) 0")
case (Le d')
with Lt ge_0 have *: "d > -d'" unfolding mult by auto
show ?thesis
proof (cases "d' < 0")
case True
from * clock_numbering(1) canonical_saturated_1[OF _ _ ‹cycle_free _ _› assms(2) c(3)] Lt Le
obtain u where "u ∈ [M]⇘v,n⇙" "u c = d'" by auto
with ‹d' < 0› assms(1) ‹c ∈ X› show ?thesis unfolding V_def by fastforce
next
case False
then have "d' ≥ 0" by auto
with ‹d > 0› have "Le (d / 2) ≤ Lt d" "Le (- (d /2)) ≤ Le d'" by auto
with canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3)] Lt Le clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - (d / 2)" by auto
with ‹d > 0› assms(1) ‹c ∈ X› show ?thesis unfolding V_def by fastforce
qed
next
case (Lt d')
with Lt' ge_0 have *: "d > -d'" unfolding mult by auto
then have **: "-d < d'" by auto
show ?thesis
proof (cases "d' ≤ 0")
case True
from assms(1,3) c obtain u where u:
"u ∈ V" "dbm_entry_val u (Some c) None (M (v c) 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with u(1) True Lt ‹c ∈ X› show ?thesis unfolding V_def by auto
next
case False
with ‹d > 0› have "Le (d / 2) ≤ Lt d" "Le (- (d /2)) ≤ Lt d'" by auto
with canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3)] Lt Lt' clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - (d / 2)" by auto
with ‹d > 0› assms(1) ‹c ∈ X› show ?thesis unfolding V_def by fastforce
qed
next
case INF
show ?thesis
proof (cases "d > 0")
case True
from ‹d > 0› have "Le (d / 2) ≤ Lt d" by auto
with INF canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3)] Lt clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - (d / 2)" by auto
with ‹d > 0› assms(1) ‹c ∈ X› show ?thesis unfolding V_def by fastforce
next
case False
with Lt show ?thesis by auto
qed
qed
qed
next
case INF
obtain u r where "u ∈ [M]⇘v,n⇙" "u c = - r" "r > 0"
proof (cases "M (v c) 0")
case (Le d)
let ?d = "if d ≤ 0 then -d + 1 else d"
from Le INF canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3), of ?d] clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - ?d" by (cases "d < 0") force+
from that[OF this] show thesis by auto
next
case (Lt d)
let ?d = "if d ≤ 0 then -d + 1 else d"
from Lt INF canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3), of ?d] clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - ?d" by (cases "d < 0") force+
from that[OF this] show thesis by auto
next
case INF
with ‹M 0 (v c) = ∞› canonical_saturated_2[OF _ _ ‹cycle_free _ _› assms(2) c(3)] clock_numbering(1)
obtain u where "u ∈ [M]⇘v,n⇙" "u c = - 1" by auto
from that[OF this] show thesis by auto
qed
with assms(1) ‹c ∈ X› show ?thesis unfolding V_def by fastforce
qed
moreover then have "¬ Le 0 ≺ M 0 (v c)" unfolding less[symmetric] by auto
ultimately have *: "?M 0 (v c) ≤ Le 0" using assms(3) c unfolding norm_def by (auto simp: Let_def)
fix u assume u: "u ∈ [?M]⇘v,n⇙"
with c have "dbm_entry_val u None (Some c) (?M 0 (v c))"
unfolding DBM_val_bounded_def DBM_zone_repr_def by auto
with * have "u c ≥ 0" by (cases "?M 0 (v c)") auto
} note ge_0 = this
then show ?thesis unfolding V_def by auto
qed
lemma norm_V_preservation:
assumes "[M]⇘v,n⇙ ⊆ V" "canonical M n"
shows "[norm M (k o v') n]⇘v,n⇙ ⊆ V" (is "[?M]⇘v,n⇙ ⊆ V")
proof (cases "[M]⇘v,n⇙ = {}")
case True
obtain i where i: "i ≤ n" "M i i < 𝟭" by (metis True assms(2) canonical_empty_zone_spec)
have "¬ Le (k (v' i)) < Le 0" unfolding less by (cases "k (v' i) = 0", auto)
with i have "?M i i < 𝟭" unfolding norm_def by (auto simp: neutral less Let_def)
with neg_diag_empty_spec[OF ‹i ≤ n›] have "[?M]⇘v,n⇙ = {}" .
then show ?thesis by auto
next
case False
from norm_set_diag[OF assms(2) False] norm_V_preservation' False assms
show ?thesis by metis
qed
lemma norm_min:
assumes "normalized M1" "[M]⇘v,n⇙ ⊆ [M1]⇘v,n⇙"
"canonical M n" "[M]⇘v,n⇙ ≠ {}" "[M]⇘v,n⇙ ⊆ V"
shows "[norm M (k o v') n]⇘v,n⇙ ⊆ [M1]⇘v,n⇙" (is "[?M2]⇘v,n⇙ ⊆ [M1]⇘v,n⇙")
proof -
have le: "⋀ i j. i ≤ n ⟹ j ≤ n ⟹ i ≠ j⟹ M i j ≤ M1 i j" using assms(2,3,4)
by (auto intro!: DBM_canonical_subset_le)
from assms have "[M1]⇘v,n⇙ ≠ {}" by auto
with neg_diag_empty_spec have *: "∀ i≤n. M1 i i ≥ Le 0" unfolding neutral by force
from assms norm_V_preservation have V: "[?M2]⇘v,n⇙ ⊆ V" by auto
have "u ∈ [M1]⇘v,n⇙" if "u ∈ [?M2]⇘v,n⇙" for u
proof -
from that V have V: "u ∈ V" by fast
show ?thesis unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (safe, goal_cases)
case 1 with * show ?case unfolding less_eq by fast
next
case (2 c)
then have c: "v c > 0" "v c ≤ n" "c ∈ X" "v' (v c) = c" using clock_numbering v_v' by metis+
with V have v_bound: "dbm_entry_val u None (Some c) (Le 0)" unfolding V_def by auto
from that c have bound:
"dbm_entry_val u None (Some c) (?M2 0 (v c))"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
show ?case
proof (cases "M 0 (v c) < Lt (- k c)")
case False
show ?thesis
proof (cases "Le 0 < M 0 (v c)")
case True
with le c(1,2) have "Le 0 ≤ M1 0 (v c)" by fastforce
with dbm_entry_val_mono_2[OF v_bound, folded less_eq] show ?thesis by fast
next
case F: False
with assms(3) False c have "?M2 0 (v c) = M 0 (v c)" unfolding less norm_def by auto
with le c bound show ?thesis by (auto intro: dbm_entry_val_mono_2[folded less_eq])
qed
next
case True
have "Lt (- k c) ≺ Le 0" by auto
with True c assms(3) have "?M2 0 (v c) = Lt (- k c)" unfolding less norm_def by auto
moreover from assms(1) c have "Lt (- k c) ≤ M1 0 (v c)" unfolding normalized by auto
ultimately show ?thesis using le c bound by (auto intro: dbm_entry_val_mono_2[folded less_eq])
qed
next
case (3 c)
then have c: "v c > 0" "v c ≤ n" "c ∈ X" "v' (v c) = c" using clock_numbering v_v' by metis+
from that c have bound:
"dbm_entry_val u (Some c) None (?M2 (v c) 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
show ?case
proof (cases "M (v c) 0 ≤ Le (k c)")
case False
with le c have "¬ M1 (v c) 0 ≤ Le (k c)" by fastforce
with assms(1) c show ?thesis unfolding normalized by fastforce
next
case True
show ?thesis
proof (cases "M (v c) 0 < Lt 0")
case T: True
have "¬ Le (real (k c)) ≺ Lt 0" by auto
with T True c have "?M2 (v c) 0 = Lt 0" unfolding norm_def less by (auto simp: Let_def)
with bound V c show ?thesis unfolding V_def by auto
next
case False
with True assms(3) c have "?M2 (v c) 0 = M (v c) 0" unfolding less less_eq norm_def
by (auto simp: Let_def)
with dbm_entry_val_mono_3[OF bound, folded less_eq] le c show ?thesis by auto
qed
qed
next
case (4 c1 c2)
then have c:
"v c1 > 0" "v c1 ≤ n" "c1 ∈ X" "v' (v c1) = c1" "v c2 > 0" "v c2 ≤ n" "c2 ∈ X" "v' (v c2) = c2"
using clock_numbering v_v' by metis+
from that c have bound:
"dbm_entry_val u (Some c1) (Some c2) (?M2 (v c1) (v c2))"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
show ?case
proof (cases "c1 = c2")
case True
then have "dbm_entry_val u (Some c1) (Some c2) (Le 0)" by auto
with c True * dbm_entry_val_mono_1[OF this, folded less_eq] show ?thesis by auto
next
case False
with clock_numbering(1) ‹v c1 ≤ n› ‹v c2 ≤ n› have neq: "v c1 ≠ v c2" by auto
show ?thesis
proof (cases "Le (k c1) < M (v c1) (v c2)")
case False
show ?thesis
proof (cases "M (v c1) (v c2) < Lt (- real (k c2))")
case F: False
with c False assms(3) have
"?M2 (v c1) (v c2) = M (v c1) (v c2)"
unfolding norm_def less by auto
with dbm_entry_val_mono_1[OF bound, folded less_eq] le c neq show ?thesis by auto
next
case True
with c False assms(3) have "?M2 (v c1) (v c2) = Lt (- k c2)" unfolding less norm_def
by auto
moreover from assms(1) c have "M1 (v c1) (v c2) = ∞ ∨ M1 (v c1) (v c2) ≥ Lt (- k c2)"
unfolding normalized by fastforce
ultimately show ?thesis using dbm_entry_val_mono_1[OF bound, folded less_eq] by auto
qed
next
case True
with le c neq have "M1 (v c1) (v c2) > Le (k c1)" by fastforce
moreover from True c assms(3) have "?M2 (v c1) (v c2) = ∞" unfolding norm_def less
by auto
moreover from assms(1) c have "M1 (v c1) (v c2) = ∞ ∨ M1 (v c1) (v c2) ≤ Le (k c1)"
unfolding normalized by fastforce
ultimately show ?thesis by auto
qed
qed
qed
qed
then show ?thesis by blast
qed
lemma apx_norm_eq:
assumes "canonical M n" "[M]⇘v,n⇙ ⊆ V" "dbm_int M n"
shows "Approx⇩β ([M]⇘v,n⇙) = [norm M (k o v') n]⇘v,n⇙"
proof -
let ?M = "norm M (k o v') n"
from assms norm_V_preservation norm_int_preservation norm_normalizes
have *: "vabstr ([?M]⇘v,n⇙) ?M" "normalized ?M" "[?M]⇘v,n⇙ ⊆ V" by presburger+
from dbm_regions'[OF this] obtain U where U: "U ⊆ ℛ" "[?M]⇘v,n⇙ = ⋃U" by auto
from assms(3) have **: "[M]⇘v,n⇙ ⊆ [?M]⇘v,n⇙" by (simp add: norm_mono clock_numbering(1) subsetI)
show ?thesis
proof (cases "[M]⇘v,n⇙ = {}")
case True
from canonical_empty_zone_spec[OF ‹canonical M n›] True obtain i where i:
"i ≤ n" "M i i < 𝟭"
by auto
with assms(3) have "?M i i < 𝟭" unfolding neutral norm_def
proof (cases "i = 0", auto intro: Lt_lt_LeI, goal_cases)
case 1
then show ?case unfolding less by auto
next
case 2
have "¬ Le (real (k (v' i))) ≺ Le 0" by auto
with 2 show ?case by (auto simp: Let_def less)
qed
from neg_diag_empty[of n v i ?M, OF _ ‹i ≤ n› this] clock_numbering have
"[?M]⇘v,n⇙ = {}"
by (auto intro: Lt_lt_LeI)
with apx_empty True show ?thesis by auto
next
case False
from apx_in[OF assms(2)] obtain U' M1 where U':
"Approx⇩β ([M]⇘v,n⇙) = ⋃U'" "U' ⊆ ℛ" "[M]⇘v,n⇙ ⊆ Approx⇩β ([M]⇘v,n⇙)"
"vabstr (Approx⇩β ([M]⇘v,n⇙)) M1" "normalized M1"
by auto
from norm_min[OF U'(5) _ assms(1) False assms(2)] U'(3,4) *(1) apx_min[OF U(2,1) _ _ *(2) **]
show ?thesis by blast
qed
qed
end
section ‹Auxiliary ‹β›-boundedness Theorems›
context Beta_Regions'
begin
lemma β_boundedness_diag_lt:
fixes m :: int
assumes "- k y ≤ m" "m ≤ k x" "x ∈ X" "y ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x - u y < m}"
proof -
note A = assms
note B = A(1,2)
let ?U = "{R ∈ ℛ. ∃ I J r c d (e :: int). R = region X I J r ∧ valid_region X k I J r ∧
(I x = Const c ∧ I y = Const d ∧ real c - d < m ∨
I x = Const c ∧ I y = Intv d ∧ real c - d ≤ m ∨
I x = Intv c ∧ I y = Const d ∧ real c + 1 - d ≤ m ∨
I x = Intv c ∧ I y = Intv d ∧ real c - d ≤ m ∧ (x,y) ∈ r ∧ (y, x) ∉ r ∨
I x = Intv c ∧ I y = Intv d ∧ real c - d < m ∧ (y, x) ∈ r ∨
(I x = Greater (k x) ∨ I y = Greater (k y)) ∧ J x y = Smaller' (- k y) ∨
(I x = Greater (k x) ∨ I y = Greater (k y)) ∧ J x y = Intv' e ∧ e < m ∨
(I x = Greater (k x) ∨ I y = Greater (k y)) ∧ J x y = Const' e ∧ e < m
)}"
{ fix u I J r assume "u ∈ region X I J r" "I x = Greater (k x) ∨ I y = Greater (k y)"
with A(3,4) have "intv'_elem x y u (J x y)" by force
} note * = this
{ fix u I J r assume "u ∈ region X I J r"
with A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" by force+
} note ** = this
have "⋃ ?U = {u ∈ V. u x - u y < m}"
proof (safe, goal_cases)
case (2 u) with **[OF this(1)] show ?case by auto
next
case (4 u) with **[OF this(1)] show ?case by auto
next
case (6 u) with **[OF this(1)] show ?case by auto
next
case (8 u X I J r c d)
from this A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" "frac (u x) < frac (u y)" by force+
with nat_intv_frac_decomp 8(4,5) have
"u x = c + frac (u x)" "u y = d + frac (u y)" "frac (u x) < frac (u y)"
by force+
with 8(6) show ?case by linarith
next
case (10 u X I J r c d)
with **[OF this(1)] 10(4,5) have "u x < c + 1" "d < u y" by auto
then have "u x - u y < real (c + 1) - real d" by linarith
moreover from 10(6) have "real c + 1 - d ≤ m"
proof -
have "int c - int d < m"
using 10(6) by linarith
then show ?thesis
by simp
qed
ultimately show ?case by linarith
next
case 12 with *[OF this(1)] B show ?case by auto
next
case 14 with *[OF this(1)] B show ?case by auto
next
case (23 u)
from region_cover_V[OF this(1)] obtain R where R: "R ∈ ℛ" "u ∈ R" by auto
then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
with R' R(2) A have C:
"intv_elem x u (I x)" "intv_elem y u (I y)" "valid_intv (k x) (I x)" "valid_intv (k y) (I y)"
by auto
{ assume A: "I x = Greater (k x) ∨ I y = Greater (k y)"
obtain intv and d :: int where intv:
"valid_intv' (k y) (k x) intv" "intv'_elem x y u intv"
"intv = Smaller' (- k y) ∨ intv = Intv' d ∧ d < m ∨ intv = Const' d ∧ d < m"
proof (cases "u x - u y < - int (k y)")
case True
have "valid_intv' (k y) (k x) (Smaller' (- k y))" ..
moreover with True have "intv'_elem x y u (Smaller' (- k y))" by auto
ultimately show thesis by (auto intro: that)
next
case False
show thesis
proof (cases "∃ (c :: int). u x - u y = c")
case True
then obtain c :: int where c: "u x - u y = c" by auto
have "valid_intv' (k y) (k x) (Const' c)" using False B(2) 23(2) c by fastforce
moreover with c have "intv'_elem x y u (Const' c)" by auto
moreover have "c < m" using c 23(2) by auto
ultimately show thesis by (auto intro: that)
next
case False
then obtain c :: real where c: "u x - u y = c" "c ∉ ℤ" by (metis Ints_cases)
have "valid_intv' (k y) (k x) (Intv' (floor c))"
proof
show "- int (k y) ≤ ⌊c⌋" using ‹¬ _ < _› c by linarith
show "⌊c⌋ < int (k x)" using B(2) 23(2) c by linarith
qed
moreover have "intv'_elem x y u (Intv' (floor c))"
proof
from c(1,2) show "⌊c⌋ < u x - u y" by (meson False eq_iff not_le of_int_floor_le)
from c(1,2) show "u x - u y < ⌊c⌋ + 1" by simp
qed
moreover have "⌊c⌋ < m" using c 23(2) by linarith
ultimately show thesis using that by auto
qed
qed
let ?J = "λ a b. if x = a ∧ y = b then intv else J a b"
let ?R = "region X I ?J r"
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
have "u ∈ ?R"
proof (standard, goal_cases)
case 1 from R R' show ?case by auto
next
case 2 from R R' show ?case by auto
next
case 3 show "?X⇩0 = ?X⇩0" by auto
next
case 4 from R R' show "∀x∈?X⇩0. ∀y∈?X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)" by auto
next
case 5
show ?case
proof (clarify, goal_cases)
case (1 a b)
show ?case
proof (cases "x = a ∧ y = b")
case True with intv show ?thesis by auto
next
case False
with R(2) R'(1) 1 show ?thesis by force
qed
qed
qed
have "valid_region X k I ?J r"
proof
show "?X⇩0 = ?X⇩0" ..
show "refl_on ?X⇩0 r" using R' by auto
show "trans r" using R' by auto
show "total_on ?X⇩0 r" using R' by auto
show "∀x∈X. valid_intv (k x) (I x)" using R' by auto
show "∀xa∈X. ∀ya∈X. isGreater (I xa) ∨ isGreater (I ya)
⟶ valid_intv' (int (k ya)) (int (k xa)) (if x = xa ∧ y = ya then intv else J xa ya)"
proof (clarify, goal_cases)
case (1 a b)
show ?case
proof (cases "x = a ∧ y = b")
case True
with B intv show ?thesis by auto
next
case False
with R'(2) 1 show ?thesis by force
qed
qed
qed
moreover then have "?R ∈ ℛ" unfolding ℛ_def by auto
ultimately have "?R ∈ ?U" using intv
apply clarify
apply (rule exI[where x = I], rule exI[where x = ?J], rule exI[where x = r])
using A by fastforce
with ‹u ∈ region _ _ _ _› have ?case by (intro Complete_Lattices.UnionI) blast+
} note * = this
show ?case
proof (cases "I x")
case (Const c)
show ?thesis
proof (cases "I y", goal_cases)
case (1 d)
with C(1,2) Const A(2,3) 23(2) have "real c - real d < m" by auto
with Const 1 R R' show ?thesis by blast
next
case (Intv d)
with C(1,2) Const A(2,3) 23(2) have "real c - (d + 1) < m" by auto
then have "c < 1 + (d + m)" by linarith
then have "real c - d ≤ m" by simp
with Const Intv R R' show ?thesis by blast
next
case (Greater d) with * C(4) show ?thesis by auto
qed
next
case (Intv c)
show ?thesis
proof (cases "I y", goal_cases)
case (Const d)
with C(1,2) Intv A(2,3) 23(2) have "real c - d < m" by auto
then have "real c < m + d" by linarith
then have "c < m + d" by linarith
then have "real c + 1 - d ≤ m" by simp
with Const Intv R R' show ?thesis by blast
next
case (2 d)
show ?thesis
proof (cases "(y, x) ∈ r")
case True
with C(1,2) R R' Intv 2 A(3,4) have
"c < u x" "u x < c + 1" "d < u y" "u y < d + 1" "frac (u x) ≥ frac (u y)"
by force+
with 23(2) nat_intv_frac_decomp have "c + frac (u x) - (d + frac (u y)) < m" by auto
with ‹frac _ ≥ _› have "real c - real d < m" by linarith
with Intv 2 True R R' show ?thesis by blast
next
case False
with R R' A(3,4) Intv 2 have "(x,y) ∈ r" by fastforce
with C(1,2) R R' Intv 2 have "c < u x" "u y < d + 1" by force+
with 23(2) have "c < 1 + d + m" by auto
then have "real c - d ≤ m" by simp
with Intv 2 False ‹_ ∈ r› R R' show ?thesis by blast
qed
next
case (Greater d) with * C(4) show ?thesis by auto
qed
next
case (Greater d) with * C(3) show ?thesis by auto
qed
qed (auto intro: A simp: V_def, (fastforce dest!: *)+)
moreover have "?U ⊆ ℛ" by fastforce
ultimately show ?thesis by blast
qed
lemma β_boundedness_diag_eq:
fixes m :: int
assumes "- k y ≤ m" "m ≤ k x" "x ∈ X" "y ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x - u y = m}"
proof -
note A = assms
note B = A(1,2)
let ?U = "{R ∈ ℛ. ∃ I J r c d (e :: int). R = region X I J r ∧ valid_region X k I J r ∧
(I x = Const c ∧ I y = Const d ∧ real c - d = m ∨
I x = Intv c ∧ I y = Intv d ∧ real c - d = m ∧ (x, y) ∈ r ∧ (y, x) ∈ r ∨
(I x = Greater (k x) ∨ I y = Greater (k y)) ∧ J x y = Const' e ∧ e = m
)}"
{ fix u I J r assume "u ∈ region X I J r" "I x = Greater (k x) ∨ I y = Greater (k y)"
with A(3,4) have "intv'_elem x y u (J x y)" by force
} note * = this
{ fix u I J r assume "u ∈ region X I J r"
with A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" by force+
} note ** = this
have "⋃ ?U = {u ∈ V. u x - u y = m}"
proof (safe, goal_cases)
case (2 u) with **[OF this(1)] show ?case by auto
next
case (4 u X I J r c d)
from this A(3,4) have "intv_elem x u (I x)" "intv_elem y u (I y)" "frac (u x) = frac (u y)" by force+
with nat_intv_frac_decomp 4(4,5) have
"u x = c + frac (u x)" "u y = d + frac (u y)" "frac (u x) = frac (u y)"
by force+
with 4(6) show ?case by linarith
next
case (9 u)
from region_cover_V[OF this(1)] obtain R where R: "R ∈ ℛ" "u ∈ R" by auto
then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
with R' R(2) A have C:
"intv_elem x u (I x)" "intv_elem y u (I y)" "valid_intv (k x) (I x)" "valid_intv (k y) (I y)"
by auto
{ assume A: "I x = Greater (k x) ∨ I y = Greater (k y)"
obtain intv where intv:
"valid_intv' (k y) (k x) intv" "intv'_elem x y u intv" "intv = Const' m"
proof (cases "u x - u y < - int (k y)")
case True
with 9 B show ?thesis by auto
next
case False
show thesis
proof (cases "∃ (c :: int). u x - u y = c")
case True
then obtain c :: int where c: "u x - u y = c" by auto
have "valid_intv' (k y) (k x) (Const' c)" using False B(2) 9(2) c by fastforce
moreover with c have "intv'_elem x y u (Const' c)" by auto
moreover have "c = m" using c 9(2) by auto
ultimately show thesis by (auto intro: that)
next
case False
then have "u x - u y ∉ ℤ" by (metis Ints_cases)
with 9 show ?thesis by auto
qed
qed
let ?J = "λ a b. if x = a ∧ y = b then intv else J a b"
let ?R = "region X I ?J r"
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
have "u ∈ ?R"
proof (standard, goal_cases)
case 1 from R R' show ?case by auto
next
case 2 from R R' show ?case by auto
next
case 3 show "?X⇩0 = ?X⇩0" by auto
next
case 4 from R R' show "∀x∈?X⇩0. ∀y∈?X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)" by auto
next
case 5
show ?case
proof (clarify, goal_cases)
case (1 a b)
show ?case
proof (cases "x = a ∧ y = b")
case True with intv show ?thesis by auto
next
case False with R(2) R'(1) 1 show ?thesis by force
qed
qed
qed
have "valid_region X k I ?J r"
proof (standard, goal_cases)
show "?X⇩0 = ?X⇩0" ..
show "refl_on ?X⇩0 r" using R' by auto
show "trans r" using R' by auto
show "total_on ?X⇩0 r" using R' by auto
show "∀x∈X. valid_intv (k x) (I x)" using R' by auto
next
case 6
then show ?case
proof (clarify, goal_cases)
case (1 a b)
show ?case
proof (cases "x = a ∧ y = b")
case True with B intv show ?thesis by auto
next
case False with R'(2) 1 show ?thesis by force
qed
qed
qed
moreover then have "?R ∈ ℛ" unfolding ℛ_def by auto
ultimately have "?R ∈ ?U" using intv
apply clarify
apply (rule exI[where x = I], rule exI[where x = ?J], rule exI[where x = r])
using A by fastforce
with ‹u ∈ region _ _ _ _› have ?case by (intro Complete_Lattices.UnionI) blast+
} note * = this
show ?case
proof (cases "I x")
case (Const c)
show ?thesis
proof (cases "I y", goal_cases)
case (1 d)
with C(1,2) Const A(2,3) 9(2) have "real c - d = m" by auto
with Const 1 R R' show ?thesis by blast
next
case (Intv d)
from Intv Const C(1,2) have range: "d < u y" "u y < d + 1" and eq: "u x = c" by auto
from eq have "u x ∈ ℤ" by auto
with nat_intv_not_int[OF range] have "u x - u y ∉ ℤ" using Ints_diff by fastforce
with 9 show ?thesis by auto
next
case Greater with C * show ?thesis by auto
qed
next
case (Intv c)
show ?thesis
proof (cases "I y", goal_cases)
case (Const d)
from Intv Const C(1,2) have range: "c < u x" "u x < c + 1" and eq: "u y = d" by auto
from eq have "u y ∈ ℤ" by auto
with nat_intv_not_int[OF range] have "u x - u y ∉ ℤ" using Ints_add by fastforce
with 9 show ?thesis by auto
next
case (2 d)
with Intv C have range: "c < u x" "u x < c + 1" "d < u y" "u y < d + 1" by auto
show ?thesis
proof (cases "(x, y) ∈ r")
case True
note T = this
show ?thesis
proof (cases "(y, x) ∈ r")
case True
with Intv 2 T R' ‹u ∈ R› A(3,4) have "frac (u x) = frac (u y)" by force
with nat_intv_frac_decomp[OF range(1,2)] nat_intv_frac_decomp[OF range(3,4)] have
"u x - u y = real c - real d"
by algebra
with 9 have "real c - d = m" by auto
with T True Intv 2 R R' show ?thesis by force
next
case False
with Intv 2 T R' ‹u ∈ R› A(3,4) have "frac (u x) < frac (u y)" by force
then have
"frac (u x - u y) ≠ 0"
by (metis add.left_neutral diff_add_cancel frac_add frac_unique_iff less_irrefl)
then have "u x - u y ∉ ℤ" by (metis frac_eq_0_iff)
with 9 show ?thesis by auto
qed
next
case False
note F = this
show ?thesis
proof (cases "x = y")
case True
with R'(2) Intv ‹x ∈ X› have "(x, y) ∈ r" "(y, x) ∈ r" by (auto simp: refl_on_def)
with Intv True R' R 9(2) show ?thesis by force
next
case False
with F R'(2) Intv 2 ‹x ∈ X› ‹y ∈ X› have "(y, x) ∈ r" by (fastforce simp: total_on_def)
with F Intv 2 R' ‹u ∈ R› A(3,4) have "frac (u x) > frac (u y)" by force
then have
"frac (u x - u y) ≠ 0"
by (metis add.left_neutral diff_add_cancel frac_add frac_unique_iff less_irrefl)
then have "u x - u y ∉ ℤ" by (metis frac_eq_0_iff)
with 9 show ?thesis by auto
qed
qed
next
case Greater with * C show ?thesis by force
qed
next
case Greater with * C show ?thesis by force
qed
qed (auto intro: A simp: V_def dest: *)
moreover have "?U ⊆ ℛ" by fastforce
ultimately show ?thesis by blast
qed
lemma β_boundedness_lt:
fixes m :: int
assumes "m ≤ k x" "x ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x < m}"
proof -
note A = assms
let ?U = "{R ∈ ℛ. ∃ I J r c. R = region X I J r ∧ valid_region X k I J r ∧
(I x = Const c ∧ c < m ∨ I x = Intv c ∧ c < m)}"
{ fix u I J r assume "u ∈ region X I J r"
with A have "intv_elem x u (I x)" by force+
} note ** = this
have "⋃ ?U = {u ∈ V. u x < m}"
proof (safe, goal_cases)
case (2 u) with **[OF this(1)] show ?case by auto
next
case (4 u) with **[OF this(1)] show ?case by auto
next
case (5 u)
from region_cover_V[OF this(1)] obtain R where R: "R ∈ ℛ" "u ∈ R" by auto
then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
with R' R(2) A have C:
"intv_elem x u (I x)" "valid_intv (k x) (I x)"
by auto
show ?case
proof (cases "I x")
case (Const c)
with 5 C(1) have "c < m" by auto
with R R' Const show ?thesis by blast
next
case (Intv c)
with 5 C(1) have "c < m" by auto
with R R' Intv show ?thesis by blast
next
case (Greater c) with 5 C A Greater show ?thesis by auto
qed
qed (auto intro: A simp: V_def)
moreover have "?U ⊆ ℛ" by fastforce
ultimately show ?thesis by blast
qed
lemma β_boundedness_gt:
fixes m :: int
assumes "m ≤ k x" "x ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x > m}"
proof -
note A = assms
let ?U = "{R ∈ ℛ. ∃ I J r c. R = region X I J r ∧ valid_region X k I J r ∧
(I x = Const c ∧ c > m ∨ I x = Intv c ∧ c ≥ m ∨ I x = Greater (k x))}"
{ fix u I J r assume "u ∈ region X I J r"
with A have "intv_elem x u (I x)" by force+
} note ** = this
have "⋃ ?U = {u ∈ V. u x > m}"
proof (safe, goal_cases)
case (2 u) with **[OF this(1)] show ?case by auto
next
case (4 u) with **[OF this(1)] show ?case by auto
next
case (6 u) with A **[OF this(1)] show ?case by auto
next
case (7 u)
from region_cover_V[OF this(1)] obtain R where R: "R ∈ ℛ" "u ∈ R" by auto
then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
with R' R(2) A have C:
"intv_elem x u (I x)" "valid_intv (k x) (I x)"
by auto
show ?case
proof (cases "I x")
case (Const c)
with 7 C(1) have "c > m" by auto
with R R' Const show ?thesis by blast
next
case (Intv c)
with 7 C(1) have "c ≥ m" by auto
with R R' Intv show ?thesis by blast
next
case (Greater c)
with C have "k x = c" by auto
with R R' Greater show ?thesis by blast
qed
qed (auto intro: A simp: V_def)
moreover have "?U ⊆ ℛ" by fastforce
ultimately show ?thesis by blast
qed
lemma β_boundedness_eq:
fixes m :: int
assumes "m ≤ k x" "x ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x = m}"
proof -
note A = assms
let ?U = "{R ∈ ℛ. ∃ I J r c. R = region X I J r ∧ valid_region X k I J r ∧ I x = Const c ∧ c = m}"
have "⋃ ?U = {u ∈ V. u x = m}"
proof (safe, goal_cases)
case (2 u) with A show ?case by force
next
case (3 u)
from region_cover_V[OF this(1)] obtain R where R: "R ∈ ℛ" "u ∈ R" by auto
then obtain I J r where R': "R = region X I J r" "valid_region X k I J r" unfolding ℛ_def by auto
with R' R(2) A have C: "intv_elem x u (I x)" "valid_intv (k x) (I x)" by auto
show ?case
proof (cases "I x")
case (Const c)
with 3 C(1) have "c = m" by auto
with R R' Const show ?thesis by blast
next
case (Intv c)
with C have "c < u x" "u x < c + 1" by auto
from nat_intv_not_int[OF this] 3 show ?thesis by auto
next
case (Greater c)
with C 3 A show ?thesis by auto
qed
qed (force intro: A simp: V_def)
moreover have "?U ⊆ ℛ" by fastforce
ultimately show ?thesis by blast
qed
lemma β_boundedness_diag_le:
fixes m :: int
assumes "- k y ≤ m" "m ≤ k x" "x ∈ X" "y ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x - u y ≤ m}"
proof -
from β_boundedness_diag_eq[OF assms] β_boundedness_diag_lt[OF assms] obtain U1 U2 where A:
"U1 ⊆ ℛ" "⋃ U1 = {u ∈ V. u x - u y < m}" "U2 ⊆ ℛ" "⋃ U2 = {u ∈ V. u x - u y = m}"
by blast
then have "{u ∈ V. u x - u y ≤ m} = ⋃ (U1 ∪ U2)" "U1 ∪ U2 ⊆ ℛ" by auto
then show ?thesis by blast
qed
lemma β_boundedness_le:
fixes m :: int
assumes "m ≤ k x" "x ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x ≤ m}"
proof -
from β_boundedness_lt[OF assms] β_boundedness_eq[OF assms] obtain U1 U2 where A:
"U1 ⊆ ℛ" "⋃ U1 = {u ∈ V. u x < m}" "U2 ⊆ ℛ" "⋃ U2 = {u ∈ V. u x = m}"
by blast
then have "{u ∈ V. u x ≤ m} = ⋃ (U1 ∪ U2)" "U1 ∪ U2 ⊆ ℛ" by auto
then show ?thesis by blast
qed
lemma β_boundedness_ge:
fixes m :: int
assumes "m ≤ k x" "x ∈ X"
shows "∃ U ⊆ ℛ. ⋃ U = {u ∈ V. u x ≥ m}"
proof -
from β_boundedness_gt[OF assms] β_boundedness_eq[OF assms] obtain U1 U2 where A:
"U1 ⊆ ℛ" "⋃ U1 = {u ∈ V. u x > m}" "U2 ⊆ ℛ" "⋃ U2 = {u ∈ V. u x = m}"
by blast
then have "{u ∈ V. u x ≥ m} = ⋃ (U1 ∪ U2)" "U1 ∪ U2 ⊆ ℛ" by auto
then show ?thesis by blast
qed
lemma β_boundedness_diag_lt':
fixes m :: int
shows
"- k y ≤ (m :: int) ⟹ m ≤ k x ⟹ x ∈ X ⟹ y ∈ X ⟹ Z ⊆ {u ∈ V. u x - u y < m}
⟹ Approx⇩β Z ⊆ {u ∈ V. u x - u y < m}"
proof (goal_cases)
case 1
note A = this
from β_boundedness_diag_lt[OF A(1-4)] obtain U where U:
"U ⊆ ℛ" "{u ∈ V. u x - u y < m} = ⋃U"
by auto
from 1 clock_numbering have *: "v x > 0" "v y > 0" "v x ≤ n" "v y ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
let ?M = "λ i j. if (i = v x ∧ j = v y) then Lt m else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x - u y < m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * ** proof (auto, goal_cases)
case (1 u c)
with clock_numbering have "c ∈ X" by metis
with 1 show ?case unfolding V_def by auto
next
case (2 u c1 c2)
with clock_numbering(1) have "x = c1" "y = c2" by auto
with 2(5) show ?case by auto
next
case (3 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u c1 c2)
with clock_numbering(1) have "x = c1" "y = c2" by auto
with 5(6) show ?case by auto
next
case (6 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have "v c > 0" "v c ≤ n" by auto
with 6(6) show "u c ≥ 0" by auto
qed
next
case (7 u)
then have "dbm_entry_val u (Some x) (Some y) (Lt (real_of_int m))" by metis
then show ?case by auto
qed
then have "vabstr {u ∈ V. u x - u y < m} ?M" by auto
moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
ultimately show ?thesis using apx_min[OF U(2,1)] A(5) by blast
qed
lemma β_boundedness_diag_le':
fixes m :: int
shows
"- k y ≤ (m :: int) ⟹ m ≤ k x ⟹ x ∈ X ⟹ y ∈ X ⟹ Z ⊆ {u ∈ V. u x - u y ≤ m}
⟹ Approx⇩β Z ⊆ {u ∈ V. u x - u y ≤ m}"
proof (goal_cases)
case 1
note A = this
from β_boundedness_diag_le[OF A(1-4)] obtain U where U:
"U ⊆ ℛ" "{u ∈ V. u x - u y ≤ m} = ⋃U"
by auto
from 1 clock_numbering have *: "v x > 0" "v y > 0" "v x ≤ n" "v y ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
let ?M = "λ i j. if (i = v x ∧ j = v y) then Le m else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x - u y ≤ m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * **
proof (auto, goal_cases)
case (1 u c)
with clock_numbering have "c ∈ X" by metis
with 1 show ?case unfolding V_def by auto
next
case (2 u c1 c2)
with clock_numbering(1) have "x = c1" "y = c2" by auto
with 2(5) show ?case by auto
next
case (3 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u c1 c2)
with clock_numbering(1) have "x = c1" "y = c2" by auto
with 5(6) show ?case by auto
next
case (6 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have "v c > 0" "v c ≤ n" by auto
with 6(6) show "u c ≥ 0" by auto
qed
next
case (7 u)
then have "dbm_entry_val u (Some x) (Some y) (Le (real_of_int m))" by metis
then show ?case by auto
qed
then have "vabstr {u ∈ V. u x - u y ≤ m} ?M" by auto
moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
ultimately show ?thesis using apx_min[OF U(2,1)] A(5) by blast
qed
lemma β_boundedness_lt':
fixes m :: int
shows
"m ≤ k x ⟹ x ∈ X ⟹ Z ⊆ {u ∈ V. u x < m} ⟹ Approx⇩β Z ⊆ {u ∈ V. u x < m}"
proof (goal_cases)
case 1
note A = this
from β_boundedness_lt[OF A(1,2)] obtain U where U: "U ⊆ ℛ" "{u ∈ V. u x < m} = ⋃U" by auto
from 1 clock_numbering have *: "v x > 0" "v x ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
let ?M = "λ i j. if (i = v x ∧ j = 0) then Lt m else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x < m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * **
proof (auto, goal_cases)
case (1 u c)
with clock_numbering have "c ∈ X" by metis
with 1 show ?case unfolding V_def by auto
next
case (2 u c1)
with clock_numbering(1) have "x = c1" by auto
with 2(4) show ?case by auto
next
case (3 u c)
with clock_numbering have "c ∈ X" by metis
with 3 show ?case unfolding V_def by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have "v c > 0" "v c ≤ n" by auto
with 5(4) show "u c ≥ 0" by auto
qed
qed
then have "vabstr {u ∈ V. u x < m} ?M" by auto
moreover have "normalized ?M" unfolding normalized less_eq dbm_le_def using A v_v' by auto
ultimately show ?thesis using apx_min[OF U(2,1)] A(3) by blast
qed
lemma β_boundedness_gt':
fixes m :: int
shows
"m ≤ k x ⟹ x ∈ X ⟹ Z ⊆ {u ∈ V. u x > m} ⟹ Approx⇩β Z ⊆ {u ∈ V. u x > m}"
proof goal_cases
case 1
from β_boundedness_gt[OF this(1,2)] obtain U where U: "U ⊆ ℛ" "{u ∈ V. u x > m} = ⋃U" by auto
from 1 clock_numbering have *: "v x > 0" "v x ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
obtain M where "vabstr {u ∈ V. u x > m} M" "normalized M"
proof (cases "m ≥ 0")
case True
let ?M = "λ i j. if (i = 0 ∧ j = v x) then Lt (-m) else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x > m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * **
proof (auto, goal_cases)
case (1 u c)
with clock_numbering(1) have "x = c" by auto
with 1(5) show ?case by auto
next
case (2 u c)
with clock_numbering have "c ∈ X" by metis
with 2 show ?case unfolding V_def by auto
next
case (3 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have c: "v c > 0" "v c ≤ n" by auto
show "u c ≥ 0"
proof (cases "v c = v x")
case False
with 5(4) c show ?thesis by auto
next
case True
with 5(4) c have "- u c < - m" by auto
with ‹m ≥ 0› show ?thesis by auto
qed
qed
qed
moreover have "normalized ?M" unfolding normalized using 1 v_v' by auto
ultimately show ?thesis by (intro that[of ?M]) auto
next
case False
then have "{u ∈ V. u x > m} = V" unfolding V_def using ‹x ∈ X› by auto
with ℛ_union all_dbm that show ?thesis by auto
qed
with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed
lemma obtains_dbm_le:
fixes m :: int
assumes "x ∈ X" "m ≤ k x"
obtains M where "vabstr {u ∈ V. u x ≤ m} M" "normalized M"
proof -
from assms clock_numbering have *: "v x > 0" "v x ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
let ?M = "λ i j. if (i = v x ∧ j = 0) then Le m else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x ≤ m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * **
proof (auto, goal_cases)
case (1 u c)
with clock_numbering have "c ∈ X" by metis
with 1 show ?case unfolding V_def by auto
next
case (2 u c1)
with clock_numbering(1) have "x = c1" by auto
with 2(4) show ?case by auto
next
case (3 u c)
with clock_numbering have "c ∈ X" by metis
with 3 show ?case unfolding V_def by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have "v c > 0" "v c ≤ n" by auto
with 5(4) show "u c ≥ 0" by auto
qed
qed
then have "vabstr {u ∈ V. u x ≤ m} ?M" by auto
moreover have "normalized ?M" unfolding normalized using assms v_v' by auto
ultimately show ?thesis ..
qed
lemma β_boundedness_le':
fixes m :: int
shows
"m ≤ k x ⟹ x ∈ X ⟹ Z ⊆ {u ∈ V. u x ≤ m} ⟹ Approx⇩β Z ⊆ {u ∈ V. u x ≤ m}"
proof (goal_cases)
case 1
from β_boundedness_le[OF this(1,2)] obtain U where U: "U ⊆ ℛ" "{u ∈ V. u x ≤ m} = ⋃U" by auto
from obtains_dbm_le 1 obtain M where "vabstr {u ∈ V. u x ≤ m} M" "normalized M" by auto
with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed
lemma obtains_dbm_ge:
fixes m :: int
assumes "x ∈ X" "m ≤ k x"
obtains M where "vabstr {u ∈ V. u x ≥ m} M" "normalized M"
proof -
from assms clock_numbering have *: "v x > 0" "v x ≤ n" by auto
have **: "⋀ c. v c = 0 ⟹ False"
proof -
fix c assume "v c = 0"
moreover from clock_numbering(1) have "v c > 0" by auto
ultimately show False by auto
qed
obtain M where "vabstr {u ∈ V. u x ≥ m} M" "normalized M"
proof (cases "m ≥ 0")
case True
let ?M = "λ i j. if (i = 0 ∧ j = v x) then Le (-m) else if i = j ∨ i = 0 then Le 0 else ∞"
have "{u ∈ V. u x ≥ m} = [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
using * **
proof (auto, goal_cases)
case (1 u c)
with clock_numbering(1) have "x = c" by auto
with 1(5) show ?case by auto
next
case (2 u c)
with clock_numbering have "c ∈ X" by metis
with 2 show ?case unfolding V_def by auto
next
case (3 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (4 u c1 c2)
with clock_numbering(1) have "c1 = c2" by auto
then show ?case by auto
next
case (5 u)
show ?case unfolding V_def
proof safe
fix c assume "c ∈ X"
with clock_numbering have c: "v c > 0" "v c ≤ n" by auto
show "u c ≥ 0"
proof (cases "v c = v x")
case False
with 5(4) c show ?thesis by auto
next
case True
with 5(4) c have "- u c ≤ - m" by auto
with ‹m ≥ 0› show ?thesis by auto
qed
qed
qed
moreover have "normalized ?M" unfolding normalized using assms v_v' by auto
ultimately show ?thesis by (intro that[of ?M]) auto
next
case False
then have "{u ∈ V. u x ≥ m} = V" unfolding V_def using ‹x ∈ X› by auto
with ℛ_union all_dbm that show ?thesis by auto
qed
then show ?thesis ..
qed
lemma β_boundedness_ge':
fixes m :: int
shows "m ≤ k x ⟹ x ∈ X ⟹ Z ⊆ {u ∈ V. u x ≥ m} ⟹ Approx⇩β Z ⊆ {u ∈ V. u x ≥ m}"
proof (goal_cases)
case 1
from β_boundedness_ge[OF this(1,2)] obtain U where U: "U ⊆ ℛ" "{u ∈ V. u x ≥ m} = ⋃U" by auto
from obtains_dbm_ge 1 obtain M where "vabstr {u ∈ V. u x ≥ m} M" "normalized M" by auto
with apx_min[OF U(2,1)] 1(3) show ?thesis by blast
qed
end
end
Theory Regions
chapter ‹The Classic Construction for Decidability›
theory Regions
imports Timed_Automata Misc
begin
text ‹
The following is a formalization of regions in the correct version of Patricia Bouyer et al.
›
section ‹Definition of Regions›
type_synonym 'c ceiling = "('c ⇒ nat)"
datatype intv =
Const nat |
Intv nat |
Greater nat
type_synonym t = real
instantiation real :: time
begin
instance proof
fix x y :: real assume "x < y"
then show "∃ z > x. z < y" using Rats_cases using dense_order_class.dense by blast
next
have "(1:: real) ≠ 0" by auto
then show "∃x. (x::real) ≠ 0" by blast
qed
end
inductive valid_intv :: "nat ⇒ intv ⇒ bool"
where
"0 ≤ d ⟹ d ≤ c ⟹ valid_intv c (Const d)" |
"0 ≤ d ⟹ d < c ⟹ valid_intv c (Intv d)" |
"valid_intv c (Greater c)"
inductive intv_elem :: "'c ⇒ ('c,t) cval ⇒ intv ⇒ bool"
where
"u x = d ⟹ intv_elem x u (Const d)" |
"d < u x ⟹ u x < d + 1 ⟹ intv_elem x u (Intv d)" |
"c < u x ⟹ intv_elem x u (Greater c)"
abbreviation "total_preorder r ≡ refl r ∧ trans r"
inductive valid_region :: "'c set ⇒ ('c ⇒ nat) ⇒ ('c ⇒ intv) ⇒ 'c rel ⇒ bool"
where
"⟦X⇩0 = {x ∈ X. ∃ d. I x = Intv d}; refl_on X⇩0 r; trans r; total_on X⇩0 r; ∀ x ∈ X. valid_intv (k x) (I x)⟧
⟹ valid_region X k I r"
inductive_set region for X I r
where
"∀ x ∈ X. u x ≥ 0 ⟹ ∀ x ∈ X. intv_elem x u (I x) ⟹ X⇩0 = {x ∈ X. ∃ d. I x = Intv d} ⟹
∀ x ∈ X⇩0. ∀ y ∈ X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)
⟹ u ∈ region X I r"
text ‹Defining the unique element of a partition that contains a valuation›
definition part ("[_]⇩_" [61,61] 61) where "part v ℛ ≡ THE R. R ∈ ℛ ∧ v ∈ R"
inductive_set Succ for ℛ R where
"u ∈ R ⟹ R ∈ ℛ ⟹ R' ∈ ℛ ⟹ t ≥ 0 ⟹ R' = [u ⊕ t]⇩ℛ ⟹ R' ∈ Succ ℛ R"
text ‹
First we need to show that the set of regions is a partition of the set of all clock
assignments. This property is only claimed by P. Bouyer.
›
inductive_cases[elim!]: "intv_elem x u (Const d)"
inductive_cases[elim!]: "intv_elem x u (Intv d)"
inductive_cases[elim!]: "intv_elem x u (Greater d)"
inductive_cases[elim!]: "valid_intv c (Greater d)"
inductive_cases[elim!]: "valid_intv c (Const d)"
inductive_cases[elim!]: "valid_intv c (Intv d)"
declare valid_intv.intros[intro]
declare intv_elem.intros[intro]
declare Succ.intros[intro]
declare Succ.cases[elim]
declare region.cases[elim]
declare valid_region.cases[elim]
section ‹Basic Properties›
text ‹First we show that all valid intervals are distinct.›
lemma valid_intv_distinct:
"valid_intv c I ⟹ valid_intv c I' ⟹ intv_elem x u I ⟹ intv_elem x u I' ⟹ I = I'"
by (cases I; cases I'; auto)
text ‹From this we show that all valid regions are distinct.›
lemma valid_regions_distinct:
"valid_region X k I r ⟹ valid_region X k I' r' ⟹ v ∈ region X I r ⟹ v ∈ region X I' r'
⟹ region X I r = region X I' r'"
proof goal_cases
case A: 1
{ fix x assume x: "x ∈ X"
with A(1) have "valid_intv (k x) (I x)" by auto
moreover from A(2) x have "valid_intv (k x) (I' x)" by auto
moreover from A(3) x have "intv_elem x v (I x)" by auto
moreover from A(4) x have "intv_elem x v (I' x)" by auto
ultimately have "I x = I' x" using valid_intv_distinct by fastforce
} note * = this
from A show ?thesis
proof (safe, goal_cases)
case A: (1 u)
have "intv_elem x u (I' x)" if "x ∈ X" for x using A(5) * that by auto
then have B: "∀ x ∈ X. intv_elem x u (I' x)" by auto
let ?X⇩0 = "{x ∈ X. ∃ d. I' x = Intv d}"
{ fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
have "(x, y) ∈ r' ⟷ frac (u x) ≤ frac (u y)"
proof
assume "frac (u x) ≤ frac (u y)"
with A(5) x y * have "(x,y) ∈ r" by auto
with A(3) x y * have "frac (v x) ≤ frac (v y)" by auto
with A(4) x y show "(x,y) ∈ r'" by auto
next
assume "(x,y) ∈ r'"
with A(4) x y have "frac (v x) ≤ frac (v y)" by auto
with A(3) x y * have "(x,y) ∈ r" by auto
with A(5) x y * show "frac (u x) ≤ frac (u y)" by auto
qed
}
then have *: "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r' ⟷ frac (u x) ≤ frac (u y)" by auto
from A(5) have "∀x∈X. 0 ≤ u x" by auto
from region.intros[OF this B _ *] show ?case by auto
next
case A: (2 u)
have "intv_elem x u (I x)" if "x ∈ X" for x using * A(5) that by auto
then have B: "∀ x ∈ X. intv_elem x u (I x)" by auto
let ?X⇩0 = "{x ∈ X. ∃ d. I x = Intv d}"
{ fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
have "(x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)"
proof
assume "frac (u x) ≤ frac (u y)"
with A(5) x y * have "(x,y) ∈ r'" by auto
with A(4) x y * have "frac (v x) ≤ frac (v y)" by auto
with A(3) x y show "(x,y) ∈ r" by auto
next
assume "(x,y) ∈ r"
with A(3) x y have "frac (v x) ≤ frac (v y)" by auto
with A(4) x y * have "(x,y) ∈ r'" by auto
with A(5) x y * show "frac (u x) ≤ frac (u y)" by auto
qed
}
then have *:"∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)" by auto
from A(5) have "∀x∈X. 0 ≤ u x" by auto
from region.intros[OF this B _ *] show ?case by auto
qed
qed
lemma ℛ_regions_distinct:
"⟦ℛ = {region X I r | I r. valid_region X k I r}; R ∈ ℛ; v ∈ R; R' ∈ ℛ; R ≠ R'⟧ ⟹ v ∉ R'"
using valid_regions_distinct by blast
text ‹
Secondly, we also need to show that every valuations belongs to a region which is part of
the partition.
›
definition intv_of :: "nat ⇒ t ⇒ intv" where
"intv_of k c ≡
if (c > k) then Greater k
else if (∃ x :: nat. x = c) then (Const (nat (floor c)))
else (Intv (nat (floor c)))"
lemma region_cover:
"∀ x ∈ X. u x ≥ 0 ⟹ ∃ R. R ∈ {region X I r | I r. valid_region X k I r} ∧ u ∈ R"
proof (standard, standard)
assume assm: "∀ x ∈ X. 0 ≤ u x"
let ?I = "λ x. intv_of (k x) (u x)"
let ?X⇩0 = "{x ∈ X. ∃ d. ?I x = Intv d}"
let ?r = "{(x,y). x ∈ ?X⇩0 ∧ y ∈ ?X⇩0 ∧ frac (u x) ≤ frac (u y)}"
show "u ∈ region X ?I ?r"
proof (standard, auto simp: assm, goal_cases)
case (1 x)
thus ?case unfolding intv_of_def
proof (auto, goal_cases)
case A: (1 a)
from A(2) have "⌊u x⌋ = u x" by (metis of_int_floor_cancel of_int_of_nat_eq)
with assm A(1) have "u x = real (nat ⌊u x⌋)" by auto
then show ?case by auto
next
case A: 2
from A(1,2) have "real (nat ⌊u x⌋) < u x"
by (metis assm floor_less_iff int_nat_eq less_eq_real_def less_irrefl not_less
of_int_of_nat_eq of_nat_0)
moreover from assm have "u x < real (nat (⌊u x⌋) + 1)" by linarith
ultimately show ?case by auto
qed
qed
have "valid_intv (k x) (intv_of (k x) (u x))" if "x ∈ X" for x using that
proof (auto simp: intv_of_def, goal_cases)
case 1 then show ?case by (intro valid_intv.intros(1)) (auto, linarith)
next
case 2
then show ?case using assm floor_less_iff nat_less_iff
by (intro valid_intv.intros(2)) fastforce+
qed
then have "valid_region X k ?I ?r"
by (intro valid_region.intros) (auto simp: refl_on_def trans_def total_on_def)
then show "region X ?I ?r ∈ {region X I r | I r. valid_region X k I r}" by auto
qed
lemma intv_not_empty:
obtains d where "intv_elem x (v(x := d)) (I x)"
proof (cases "I x", goal_cases)
case (1 d)
then have "intv_elem x (v(x := d)) (I x)" by auto
with 1 show ?case by auto
next
case (2 d)
then have "intv_elem x (v(x := d + 0.5)) (I x)" by auto
with 2 show ?case by auto
next
case (3 d)
then have "intv_elem x (v(x := d + 0.5)) (I x)" by auto
with 3 show ?case by auto
qed
fun get_intv_val :: "intv ⇒ real ⇒ real"
where
"get_intv_val (Const d) _ = d" |
"get_intv_val (Intv d) f = d + f" |
"get_intv_val (Greater d) _ = d + 1"
lemma region_not_empty_aux:
assumes "0 < f" "f < 1" "0 < g" "g < 1"
shows "frac (get_intv_val (Intv d) f) ≤ frac (get_intv_val (Intv d') g) ⟷ f ≤ g"
using assms by (simp, metis frac_eq frac_nat_add_id less_eq_real_def)
lemma region_not_empty:
assumes "finite X" "valid_region X k I r"
shows "∃ u. u ∈ region X I r"
proof -
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
obtain f :: "'a ⇒ nat" where f:
"∀x∈?X⇩0. ∀y∈?X⇩0. f x ≤ f y ⟷ (x, y) ∈ r"
apply (rule finite_total_preorder_enumeration)
apply (subgoal_tac "finite ?X⇩0")
apply assumption
using assms by auto
let ?M = "if ?X⇩0 ≠ {} then Max {f x | x. x ∈ ?X⇩0} else 1"
let ?f = "λ x. (f x + 1) / (?M + 2)"
let ?v = "λ x. get_intv_val (I x) (if x ∈ ?X⇩0 then ?f x else 1)"
have frac_intv: "∀x∈?X⇩0. 0 < ?f x ∧ ?f x < 1"
proof (standard, goal_cases)
case (1 x)
then have *: "?X⇩0 ≠ {}" by auto
have "f x ≤ Max {f x | x. x ∈ ?X⇩0}" apply (rule Max_ge) using ‹finite X› 1 by auto
with 1 show ?case by auto
qed
with region_not_empty_aux have *:
"∀x∈?X⇩0. ∀y∈?X⇩0. frac (?v x) ≤ frac (?v y) ⟷ ?f x ≤ ?f y"
by force
have "∀x∈?X⇩0. ∀y∈?X⇩0. ?f x ≤ ?f y ⟷ f x ≤ f y" by (simp add: divide_le_cancel)+
with f have "∀x∈?X⇩0. ∀y∈?X⇩0. ?f x ≤ ?f y ⟷ (x, y) ∈ r" by auto
with * have frac_order: "∀x∈?X⇩0. ∀y∈?X⇩0. frac (?v x) ≤ frac (?v y) ⟷ (x, y) ∈ r" by auto
have "?v ∈ region X I r"
proof standard
show "∀x∈X. intv_elem x ?v (I x)"
proof (standard, case_tac "I x", goal_cases)
case (2 x d)
then have *: "x ∈ ?X⇩0" by auto
with frac_intv have "0 < ?f x" "?f x < 1" by auto
moreover from 2 have "?v x = d + ?f x" by auto
ultimately have "?v x < d + 1 ∧ d < ?v x" by linarith
then show "intv_elem x ?v (I x)" by (subst 2(2)) (intro intv_elem.intros(2), auto)
qed auto
next
show "∀x∈X. 0 ≤ get_intv_val (I x) (if x ∈ ?X⇩0 then ?f x else 1)"
by (standard, case_tac "I x") auto
next
show "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I x = Intv d}" ..
next
from frac_order show "∀x∈?X⇩0. ∀y∈?X⇩0. ((x, y) ∈ r) = (frac (?v x) ≤ frac (?v y))" by blast
qed
then show ?thesis by auto
qed
text ‹
Now we can show that there is always exactly one region a valid valuation belongs to.
›
lemma regions_partition:
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ ∀x ∈ X. 0 ≤ u x ⟹ ∃! R ∈ ℛ. u ∈ R"
proof (goal_cases)
case 1
note A = this
with region_cover[OF A(2)] obtain R where R: "R ∈ ℛ ∧ u ∈ R" by fastforce
moreover have "R' = R" if "R' ∈ ℛ ∧ u ∈ R'" for R'
using that R valid_regions_distinct unfolding A(1) by blast
ultimately show ?thesis by auto
qed
lemma region_unique:
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ u ∈ R ⟹ R ∈ ℛ ⟹ [u]⇩ℛ = R"
proof (goal_cases)
case 1
note A = this
from A obtain I r where *: "valid_region X k I r" "R = region X I r" "u ∈ region X I r" by auto
from this(3) have "∀x∈X. 0 ≤ u x" by auto
from theI'[OF regions_partition[OF A(1) this]] A(1) obtain I' r' where
v: "valid_region X k I' r'" "[u]⇩ℛ = region X I' r'" "u ∈ region X I' r'"
unfolding part_def by auto
from valid_regions_distinct[OF *(1) v(1) *(3) v(3)] v(2) *(2) show ?case by auto
qed
lemma regions_partition':
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ ∀x∈X. 0 ≤ v x ⟹ ∀x∈X. 0 ≤ v' x ⟹ v' ∈ [v]⇩ℛ
⟹ [v']⇩ℛ = [v]⇩ℛ"
proof (goal_cases)
case 1
note A = this
from theI'[OF regions_partition[OF A(1,2)]] A(1,4) obtain I r where
v: "valid_region X k I r" "[v]⇩ℛ = region X I r" "v' ∈ region X I r"
unfolding part_def by auto
from theI'[OF regions_partition[OF A(1,3)]] A(1) obtain I' r' where
v': "valid_region X k I' r'" "[v']⇩ℛ = region X I' r'" "v' ∈ region X I' r'"
unfolding part_def by auto
from valid_regions_distinct[OF v'(1) v(1) v'(3) v(3)] v(2) v'(2) show ?case by simp
qed
lemma regions_closed:
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ R ∈ ℛ ⟹ v ∈ R ⟹ t ≥ 0 ⟹ [v ⊕ t]⇩ℛ ∈ ℛ"
proof goal_cases
case A: 1
then obtain I r where "v ∈ region X I r" by auto
from this(1) have "∀ x ∈ X. v x ≥ 0" by auto
with A(4) have "∀ x ∈ X. (v ⊕ t) x ≥ 0" unfolding cval_add_def by simp
from regions_partition[OF A(1) this] obtain R' where "R' ∈ ℛ" "(v ⊕ t) ∈ R'" by auto
with region_unique[OF A(1) this(2,1)] show ?case by auto
qed
lemma regions_closed':
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ R ∈ ℛ ⟹ v ∈ R ⟹ t ≥ 0 ⟹ (v ⊕ t) ∈ [v ⊕ t]⇩ℛ"
proof goal_cases
case A: 1
then obtain I r where "v ∈ region X I r" by auto
from this(1) have "∀ x ∈ X. v x ≥ 0" by auto
with A(4) have "∀ x ∈ X. (v ⊕ t) x ≥ 0" unfolding cval_add_def by simp
from regions_partition[OF A(1) this] obtain R' where "R' ∈ ℛ" "(v ⊕ t) ∈ R'" by auto
with region_unique[OF A(1) this(2,1)] show ?case by auto
qed
lemma valid_regions_I_cong:
"valid_region X k I r ⟹ ∀ x ∈ X. I x = I' x ⟹ region X I r = region X I' r ∧ valid_region X k I' r"
proof (safe, goal_cases)
case (1 v)
note A = this
then have [simp]:"⋀ x. x ∈ X ⟹ I' x = I x" by metis
show ?case
proof (standard, goal_cases)
case 1
from A(3) show ?case by auto
next
case 2
from A(3) show ?case by auto
next
case 3
show "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}" by auto
next
case 4
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
from A(3) show "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. ((x, y) ∈ r) = (frac (v x) ≤ frac (v y))" by auto
qed
next
case (2 v)
note A = this
then have [simp]:"⋀ x. x ∈ X ⟹ I' x = I x" by metis
show ?case
proof (standard, goal_cases)
case 1
from A(3) show ?case by auto
next
case 2
from A(3) show ?case by auto
next
case 3
show "{x ∈ X. ∃d. I' x = Intv d} = {x ∈ X. ∃d. I x = Intv d}" by auto
next
case 4
let ?X⇩0 = "{x ∈ X. ∃d. I' x = Intv d}"
from A(3) show "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. ((x, y) ∈ r) = (frac (v x) ≤ frac (v y))" by auto
qed
next
case 3
note A = this
then have [simp]:"⋀ x. x ∈ X ⟹ I' x = I x" by metis
show ?case
apply rule
apply (subgoal_tac "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}")
apply assumption
using A by auto
qed
fun intv_const :: "intv ⇒ nat"
where
"intv_const (Const d) = d" |
"intv_const (Intv d) = d" |
"intv_const (Greater d) = d"
lemma finite_ℛ:
notes [[simproc add: finite_Collect]] finite_subset[intro]
fixes X k
defines "ℛ ≡ {region X I r | I r. valid_region X k I r}"
assumes "finite X"
shows "finite ℛ"
proof -
{ fix I r assume A: "valid_region X k I r"
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
from A have "refl_on ?X⇩0 r" by auto
then have "r ⊆ X × X" by (auto simp: refl_on_def)
then have "r ∈ Pow (X × X)" by auto
}
then have "{r. ∃I. valid_region X k I r} ⊆ Pow (X × X)" by auto
with ‹finite X› have fin: "finite {r. ∃I. valid_region X k I r}" by auto
let ?m = "Max {k x | x. x ∈ X}"
let ?I = "{intv. intv_const intv ≤ ?m}"
let ?fin_map = "λ I. ∀x. (x ∈ X ⟶ I x ∈ ?I) ∧ (x ∉ X ⟶ I x = Const 0)"
let ?ℛ = "{region X I r | I r. valid_region X k I r ∧ ?fin_map I}"
have "?I = (Const ` {d. d ≤ ?m}) ∪ (Intv ` {d. d ≤ ?m}) ∪ (Greater ` {d. d ≤ ?m})"
by auto (case_tac x, auto)
then have "finite ?I" by auto
from finite_set_of_finite_funs[OF ‹finite X› this] have "finite {I. ?fin_map I}" .
with fin have "finite {(I, r). valid_region X k I r ∧ ?fin_map I}"
by (fastforce intro: pairwise_finiteI finite_ex_and1 frac_add_le_preservation del: finite_subset)
then have "finite ?ℛ" by fastforce
moreover have "ℛ ⊆ ?ℛ"
proof
fix R assume R: "R ∈ ℛ"
then obtain I r where I: "R = region X I r" "valid_region X k I r" unfolding ℛ_def by auto
let ?I = "λ x. if x ∈ X then I x else Const 0"
let ?R = "region X ?I r"
from valid_regions_I_cong[OF I(2)] I have "R = ?R" "valid_region X k ?I r" by auto
moreover have "∀x. x ∉ X ⟶ ?I x = Const 0" by auto
moreover have "∀x. x ∈ X ⟶ intv_const (I x) ≤ ?m"
proof auto
fix x assume x: "x ∈ X"
with I(2) have "valid_intv (k x) (I x)" by auto
moreover from ‹finite X› x have "k x ≤ ?m" by (auto intro: Max_ge)
ultimately show "intv_const (I x) ≤ Max {k x |x. x ∈ X}" by (cases "I x") auto
qed
ultimately show "R ∈ ?ℛ" by force
qed
ultimately show "finite ℛ" by blast
qed
lemma SuccI2:
"ℛ = {region X I r | I r. valid_region X k I r} ⟹ v ∈ R ⟹ R ∈ ℛ ⟹ t ≥ 0 ⟹ R' = [v ⊕ t]⇩ℛ
⟹ R' ∈ Succ ℛ R"
proof goal_cases
case A: 1
from Succ.intros[OF A(2) A(3) regions_closed[OF A(1,3,2,4)] A(4)] A(5) show ?case by auto
qed
section ‹Set of Regions›
text ‹
The first property Bouyer shows is that these regions form a 'set of regions'.
›
text ‹
For the unbounded region in the upper right corner, the set of successors only
contains itself.
›
lemma Succ_refl:
"ℛ = {region X I r |I r. valid_region X k I r} ⟹ finite X ⟹ R ∈ ℛ ⟹ R ∈ Succ ℛ R"
proof goal_cases
case A: 1
then obtain I r where R: "valid_region X k I r" "R = region X I r" by auto
with A region_not_empty obtain v where v: "v ∈ region X I r" by metis
with R have *: "(v ⊕ 0) ∈ R" unfolding cval_add_def by auto
from regions_closed'[OF A(1,3-)] v R have "(v ⊕ 0) ∈ [v ⊕ 0]⇩ℛ" by auto
from region_unique[OF A(1) * A(3)] A(3) v[unfolded R(2)[symmetric]] show ?case by auto
qed
lemma Succ_refl':
"ℛ = {region X I r |I r. valid_region X k I r} ⟹ finite X ⟹ ∀ x ∈ X. ∃ c. I x = Greater c
⟹ region X I r ∈ ℛ ⟹ Succ ℛ (region X I r) = {region X I r}"
proof goal_cases
case A: 1
have *: "(v ⊕ t) ∈ region X I r" if v: "v ∈ region X I r" and t: "t ≥ 0" for v and t :: t
proof ((rule region.intros), auto, goal_cases)
case 1
with v t show ?case unfolding cval_add_def by auto
next
case (2 x)
with A obtain c where c: "I x = Greater c" by auto
with v 2 have "v x > c" by fastforce
with t have "v x + t > c" by auto
then have "(v ⊕ t) x > c" by (simp add: cval_add_def)
from intv_elem.intros(3)[of c "v ⊕ t", OF this] c show ?case by auto
next
case (3 x)
from this(1) A obtain c where "I x = Greater c" by auto
with 3(2) show ?case by auto
next
case (4 x)
from this(1) A obtain c where "I x = Greater c" by auto
with 4(2) show ?case by auto
qed
show ?case
proof (standard, standard)
fix R assume R: "R ∈ Succ ℛ (region X I r)"
then obtain v t where v:
"v ∈ region X I r" "R = [v ⊕ t]⇩ℛ" "R ∈ ℛ" "t ≥ 0"
by (cases rule: Succ.cases) auto
from v(1) have **: "∀x ∈ X. 0 ≤ v x" by auto
with v(4) have "∀x ∈ X. 0 ≤ (v ⊕ t) x" unfolding cval_add_def by auto
from *[OF v(1,4)] regions_partition'[OF A(1) ** this] region_unique[OF A(1) v(1) A(4)] v(2)
show "R ∈ {region X I r}" by auto
next
from A(4) obtain I' r' where R': "region X I r = region X I' r'" "valid_region X k I' r'"
unfolding A(1) by auto
with region_not_empty[OF A(2) this(2)] obtain v where v: "v ∈ region X I r" by auto
from region_unique[OF A(1) this A(4)] have *: "[v ⊕ 0]⇩ℛ = region X I r"
unfolding cval_add_def by auto
with v A(4) have "[v ⊕ 0]⇩ℛ ∈ Succ ℛ (region X I r)" by (intro Succ.intros; auto)
with * show "{region X I r} ⊆ Succ ℛ (region X I r)" by auto
qed
qed
text ‹
Defining the closest successor of a region. Only exists if at least one interval is upper-bounded.
›
definition
"succ ℛ R =
(SOME R'. R' ∈ Succ ℛ R ∧ (∀ u ∈ R. ∀ t ≥ 0. (u ⊕ t) ∉ R ⟶ (∃ t' ≤ t. (u ⊕ t') ∈ R' ∧ 0 ≤ t')))"
inductive isConst :: "intv ⇒ bool"
where
"isConst (Const _)"
inductive isIntv :: "intv ⇒ bool"
where
"isIntv (Intv _)"
inductive isGreater :: "intv ⇒ bool"
where
"isGreater (Greater _)"
declare isIntv.intros[intro!] isConst.intros[intro!] isGreater.intros[intro!]
declare isIntv.cases[elim!] isConst.cases[elim!] isGreater.cases[elim!]
text ‹
What Bouyer states at the end. However, we have to be a bit more precise than in her statement.
›
lemma closest_prestable_1:
fixes I X k r
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
defines "R ≡ region X I r"
defines "Z ≡ {x ∈ X . ∃ c. I x = Const c}"
assumes "Z ≠ {}"
defines "I'≡ λ x. if x ∉ Z then I x else if intv_const (I x) = k x then Greater (k x) else Intv (intv_const (I x))"
defines "r' ≡ r ∪ {(x,y) . x ∈ Z ∧ y ∈ X ∧ intv_const (I x) < k x ∧ isIntv (I' y)}"
assumes "finite X"
assumes "valid_region X k I r"
shows "∀ v ∈ R. ∀ t>0. ∃t'≤t. (v ⊕ t') ∈ region X I' r' ∧ t' ≥ 0"
and "∀ v ∈ region X I' r'. ∀ t≥0. (v ⊕ t) ∉ R"
and "∀ x ∈ X. ¬ isConst (I' x)"
and "∀ v ∈ R. ∀ t < 1. ∀ t' ≥ 0. (v ⊕ t') ∈ region X I' r'
⟶ {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ c + 1)}
= {x. x ∈ X ∧ (∃ c. I' x = Intv c ∧ (v ⊕ t') x + (t - t') ≥ c + 1)}"
proof (safe, goal_cases)
fix v assume v: "v ∈ R" fix t :: t assume t: "0 < t"
have elem: "intv_elem x v (I x)" if x: "x ∈ X" for x using v x unfolding R_def by auto
have *: "(v ⊕ t) ∈ region X I' r'" if A: "∀ x ∈ X. ¬ isIntv (I x)" and t: "t > 0" "t < 1" for t
proof (standard, goal_cases)
case 1
from v have "∀ x ∈ X. v x ≥ 0" unfolding R_def by auto
with t show ?case unfolding cval_add_def by auto
next
case 2
show ?case
proof (standard, case_tac "I x", goal_cases)
case (1 x c)
with elem[OF ‹x ∈ X›] have "v x = c" by auto
show ?case
proof (cases "intv_const (I x) = k x", auto simp: 1 I'_def Z_def, goal_cases)
case 1
with ‹v x = c› have "v x = k x" by auto
with t show ?case by (auto simp: cval_add_def)
next
case 2
from assms(8) 1 have "c ≤ k x" by (cases rule: valid_region.cases) auto
with 2 have "c < k x" by linarith
from t ‹v x = c› show ?case by (auto simp: cval_add_def)
qed
next
case (2 x c)
with A show ?case by auto
next
case (3 x c)
then have "I' x = Greater c" unfolding I'_def Z_def by auto
with t 3 elem[OF ‹x ∈ X›] show ?case by (auto simp: cval_add_def)
qed
next
case 3 show "{x ∈ X. ∃d. I' x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}" ..
next
case 4
let ?X⇩0' = "{x ∈ X. ∃d. I' x = Intv d}"
show "∀x∈?X⇩0'. ∀y∈?X⇩0'. ((x, y) ∈ r') = (frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y))"
proof (safe, goal_cases)
case (1 x y d d')
note B = this
have "x ∈ Z" apply (rule ccontr) using A B by (auto simp: I'_def)
with elem[OF B(1)] have "frac (v x) = 0 " unfolding Z_def by auto
with frac_distr[of t "v x"] t have *: "frac (v x + t) = t" by auto
have "y ∈ Z" apply (rule ccontr) using A B by (auto simp: I'_def)
with elem[OF B(3)] have "frac (v y) = 0 " unfolding Z_def by auto
with frac_distr[of t "v y"] t have "frac (v y + t) = t" by auto
with * show ?case unfolding cval_add_def by auto
next
case B: (2 x)
have "x ∈ Z" apply (rule ccontr) using A B by (auto simp: I'_def)
with B have "intv_const (I x) ≠ k x" unfolding I'_def by auto
with B(1) assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
with B ‹x ∈ Z› show ?case unfolding r'_def by auto
qed
qed
let ?S = "{1 - frac (v x) | x. x ∈ X ∧ isIntv (I x)}"
let ?t = "Min ?S"
{ assume A: "∃ x ∈ X. isIntv (I x)"
from ‹finite X› have "finite ?S" by auto
from A have "?S ≠ {}" by auto
from Min_in[OF ‹finite ?S› this] obtain x where
x: "x ∈ X" "isIntv (I x)" "?t = 1 - frac (v x)"
by force
have "frac (v x) < 1" by (simp add: frac_lt_1)
then have "?t > 0" by (simp add: x(3))
then have "?t / 2 > 0" by auto
from x(2) obtain c where "I x = Intv c" by (auto)
with elem[OF x(1)] have v_x: "c < v x" "v x < c + 1" by auto
from nat_intv_frac_gt0[OF this] have "frac (v x) > 0" .
with x(3) have "?t < 1" by auto
{ fix t :: t assume t: "0 < t" "t ≤ ?t / 2"
{ fix y assume "y ∈ X" "isIntv (I y)"
then have "1 - frac (v y) ∈ ?S" by auto
from Min_le[OF ‹finite ?S› this] ‹?t > 0› t have "t < 1 - frac (v y)" by linarith
} note frac_bound = this
have "(v ⊕ t) ∈ region X I' r'"
proof (standard, goal_cases)
case 1
from v have "∀ x ∈ X. v x ≥ 0" unfolding R_def by auto
with ‹?t > 0› t show ?case unfolding cval_add_def by auto
next
case 2
show ?case
proof (standard, case_tac "I x", goal_cases)
case A: (1 x c)
with elem[OF ‹x ∈ X›] have "v x = c" by auto
show ?case
proof (cases "intv_const (I x) = k x", auto simp: A I'_def Z_def, goal_cases)
case 1
with ‹v x = c› have "v x = k x" by auto
with ‹?t > 0› t show ?case by (auto simp: cval_add_def)
next
case 2
from assms(8) A have "c ≤ k x" by (cases rule: valid_region.cases) auto
with 2 have "c < k x" by linarith
from ‹v x = c› ‹?t < 1› t show ?case
by (auto simp: cval_add_def)
qed
next
case (2 x c)
with elem[OF ‹x ∈ X›] have v: "c < v x" "v x < c + 1" by auto
with ‹?t > 0› have "c < v x + (?t / 2)" by auto
from 2 have "I' x = I x" unfolding I'_def Z_def by auto
from frac_bound[OF 2(1)] 2(2) have "t < 1 - frac (v x)" by auto
from frac_add_le_preservation[OF v(2) this] t v(1) 2 show ?case
unfolding cval_add_def ‹I' x = I x› by auto
next
case (3 x c)
then have "I' x = Greater c" unfolding I'_def Z_def by auto
with 3 elem[OF ‹x ∈ X›] t show ?case
by (auto simp: cval_add_def)
qed
next
case 3 show "{x ∈ X. ∃d. I' x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}" ..
next
case 4
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
let ?X⇩0' = "{x ∈ X. ∃d. I' x = Intv d}"
show "∀x∈?X⇩0'. ∀y∈?X⇩0'. ((x, y) ∈ r') = (frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y))"
proof (safe, goal_cases)
case (1 x y d d')
note B = this
show ?case
proof (cases "x ∈ Z")
case False
note F = this
show ?thesis
proof (cases "y ∈ Z")
case False
with F B have *: "x ∈ ?X⇩0" "y ∈ ?X⇩0" unfolding I'_def by auto
from B(5) show ?thesis unfolding r'_def
proof (safe, goal_cases)
case 1
with v * have le: "frac (v x) <= frac (v y)" unfolding R_def by auto
from frac_bound * have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by fastforce+
with frac_distr t have
"frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
by simp+
with le show ?case unfolding cval_add_def by fastforce
next
case 2
from this(1) elem have **: "frac (v x) = 0" unfolding Z_def by force
from 2(4) obtain c where "I' y = Intv c" by (auto )
then have "y ∈ Z ∨ I y = Intv c" unfolding I'_def by presburger
then show ?case
proof
assume "y ∈ Z"
with elem[OF 2(2)] have ***: "frac (v y) = 0" unfolding Z_def by force
show ?thesis by (simp add: ** *** frac_add cval_add_def)
next
assume A: "I y = Intv c"
have le: "frac (v x) <= frac (v y)" by (simp add: **)
from frac_bound * have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by fastforce+
with 2 t have
"frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
using F by blast+
with le show ?case unfolding cval_add_def by fastforce
qed
qed
next
case True
then obtain d' where d': "I y = Const d'" unfolding Z_def by auto
from B(5) show ?thesis unfolding r'_def
proof (safe, goal_cases)
case 1
from d' have "y ∉ ?X⇩0" by auto
moreover from assms(8) have "refl_on ?X⇩0 r" by auto
ultimately show ?case unfolding refl_on_def using 1 by auto
next
case 2
with F show ?case by simp
qed
qed
next
case True
with elem have **: "frac (v x) = 0" unfolding Z_def by force
from B(4) have "y ∈ Z ∨ I y = Intv d'" unfolding I'_def by presburger
then show ?thesis
proof
assume "y ∈ Z"
with elem[OF B(3)] have ***: "frac (v y) = 0" unfolding Z_def by force
show ?thesis by (simp add: ** *** frac_add cval_add_def)
next
assume A: "I y = Intv d'"
with B(3) have "y ∈ ?X⇩0" by auto
with frac_bound have "t < 1 - frac (v y)" by fastforce+
moreover from ** ‹?t < 1› have "?t / 2 < 1 - frac (v x)" by linarith
ultimately have
"frac (v x) + t = frac (v x + t)" "frac (v y) + t = frac (v y + t)"
using frac_distr t by simp+
moreover have "frac (v x) <= frac (v y)" by (simp add: **)
ultimately show ?thesis unfolding cval_add_def by fastforce
qed
qed
next
case B: (2 x y d d')
show ?case
proof (cases "x ∈ Z", goal_cases)
case True
with B(1,2) have "intv_const (I x) ≠ k x" unfolding I'_def by auto
with B(1) assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
with B True show ?thesis unfolding r'_def by auto
next
case (False)
with B(1,2) have x_intv: "isIntv (I x)" unfolding Z_def I'_def by auto
show ?thesis
proof (cases "y ∈ Z")
case False
with B(3,4) have y_intv: "isIntv (I y)" unfolding Z_def I'_def by auto
with frac_bound x_intv B(1,3) have "t < 1 - frac (v x)" "t < 1 - frac (v y)" by auto
from frac_add_leD[OF _ this] B(5) t have
"frac (v x) ≤ frac (v y)"
by (auto simp: cval_add_def)
with v assms(2) B(1,3) x_intv y_intv have "(x, y) ∈ r" by (auto )
then show ?thesis by (simp add: r'_def)
next
case True
from frac_bound x_intv B(1) have b: "t < 1 - frac (v x)" by auto
from x_intv obtain c where "I x = Intv c" by auto
with elem[OF ‹x ∈ X›] have v: "c < v x" "v x < c + 1" by auto
from True elem[OF ‹y ∈ X›] have *: "frac (v y) = 0" unfolding Z_def by auto
with t ‹?t < 1› floor_frac_add_preservation'[of t "v y"] have
"floor (v y + t) = floor (v y)"
by auto
then have "frac (v y + t) = t"
by (metis * add_diff_cancel_left' diff_add_cancel diff_self frac_def)
moreover from nat_intv_frac_gt0[OF v] have "0 < frac (v x)" .
moreover from frac_distr[OF _ b] t have "frac (v x + t) = frac (v x) + t" by auto
ultimately show ?thesis using B(5) unfolding cval_add_def by auto
qed
qed
qed
qed
}
with ‹?t/2 > 0› have "0 < ?t/2 ∧ (∀ t. 0 < t ∧ t ≤ ?t/2 ⟶ (v ⊕ t) ∈ region X I' r')" by auto
} note ** = this
show "∃t'≤t. (v ⊕ t') ∈ region X I' r' ∧ 0 ≤ t'"
proof (cases "∃ x ∈ X. isIntv (I x)")
case True
note T = this
show ?thesis
proof (cases "t ≤ ?t/2")
case True with T t ** show ?thesis by auto
next
case False
then have "?t/2 ≤ t" by auto
moreover from T ** have "(v ⊕ ?t/2) ∈ region X I' r'" "?t/2 > 0" by auto
ultimately show ?thesis by (fastforce del: region.cases)
qed
next
case False
note F = this
show ?thesis
proof (cases "t < 1")
case True with F t * show ?thesis by auto
next
case False
then have "0.5 ≤ t" by auto
moreover from F * have "(v ⊕ 0.5) ∈ region X I' r'" by auto
ultimately show ?thesis by (fastforce del: region.cases)
qed
qed
next
fix v t assume A: "v ∈ region X I' r'" "0 ≤ t" "(v ⊕ t) ∈ R"
from assms(3,4) obtain x c where x: "I x = Const c" "x ∈ Z" "x ∈ X" by auto
with A(1) have "intv_elem x v (I' x)" by auto
with x have "v x > c" unfolding I'_def
apply (auto elim: intv_elem.cases)
apply (cases "c = k x")
by auto
moreover from A(3) x(1,3) have "v x + t = c"
by (fastforce elim!: intv_elem.cases simp: cval_add_def R_def)
ultimately show False using A(2) by auto
next
fix x c assume "x ∈ X" "I' x = Const c"
then show False
apply (auto simp: I'_def Z_def)
apply (cases "∀c. I x ≠ Const c")
apply auto
apply (rename_tac c')
apply (case_tac "c' = k x")
by auto
next
case (4 v t t' x c)
note A = this
then have "I' x = Intv c" unfolding I'_def Z_def by auto
moreover from A have "real (c + 1) ≤ (v ⊕ t') x + (t - t')" unfolding cval_add_def by auto
ultimately show ?case by blast
next
case A: (5 v t t' x c)
show ?case
proof (cases "x ∈ Z")
case False
with A have "I x = Intv c" unfolding I'_def by auto
with A show ?thesis unfolding cval_add_def by auto
next
case True
with A(6) have "I x = Const c"
apply (auto simp: I'_def)
apply (cases "intv_const (I x) = k x")
by (auto simp: Z_def)
with A(1,5) R_def have "v x = c" by fastforce
with A(2,7) show ?thesis by (auto simp: cval_add_def)
qed
qed
lemma closest_valid_1:
fixes I X k r
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
defines "R ≡ region X I r"
defines "Z ≡ {x ∈ X . ∃ c. I x = Const c}"
assumes "Z ≠ {}"
defines "I'≡ λ x. if x ∉ Z then I x else if intv_const (I x) = k x then Greater (k x) else Intv (intv_const (I x))"
defines "r' ≡ r ∪ {(x,y) . x ∈ Z ∧ y ∈ X ∧ intv_const (I x) < k x ∧ isIntv (I' y)}"
assumes "finite X"
assumes "valid_region X k I r"
shows "valid_region X k I' r'"
proof
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
let ?X⇩0' = "{x ∈ X. ∃d. I' x = Intv d}"
let ?S = "{(x, y). x ∈ Z ∧ y ∈ X ∧ intv_const (I x) < k x ∧ isIntv (I' y)}"
show "?X⇩0' = ?X⇩0'" ..
from assms(8) have refl: "refl_on ?X⇩0 r" and total: "total_on ?X⇩0 r" and trans: "trans r"
and valid: "⋀ x. x ∈ X ⟹ valid_intv (k x) (I x)"
by auto
then have "r ⊆ ?X⇩0 × ?X⇩0" unfolding refl_on_def by auto
then have "r ⊆ ?X⇩0' × ?X⇩0'" unfolding I'_def Z_def by auto
moreover have "?S ⊆ ?X⇩0' × ?X⇩0'"
apply (auto)
apply (auto simp: Z_def)[]
apply (auto simp: I'_def)[]
done
ultimately have "r'⊆ ?X⇩0' × ?X⇩0'" unfolding r'_def by auto
then show "refl_on ?X⇩0' r'" unfolding refl_on_def
proof auto
fix x d assume A: "x ∈ X" "I' x = Intv d"
show "(x, x) ∈ r'"
proof (cases "x ∈ Z")
case True
with A have "intv_const (I x) ≠ k x" unfolding I'_def by auto
with assms(8) A(1) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
with True A show "(x,x) ∈ r'" by (auto simp: r'_def)
next
case False
with A refl show "(x,x) ∈ r'" by (auto simp: I'_def refl_on_def r'_def)
qed
qed
show "total_on ?X⇩0' r'" unfolding total_on_def
proof (standard, standard, standard)
fix x y assume "x ∈ ?X⇩0'" "y ∈ ?X⇩0'" "x ≠ y"
then obtain d d' where A: "x∈X""y∈X""I' x = (Intv d)" "I' y = (Intv d')" "x ≠ y" by auto
let ?thesis = "(x, y) ∈ r' ∨ (y, x) ∈ r'"
show ?thesis
proof (cases "x ∈ Z")
case True
with A have "intv_const (I x) ≠ k x" unfolding I'_def by auto
with assms(8) A(1) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
with True A show ?thesis by (auto simp: r'_def)
next
case F: False
show ?thesis
proof (cases "y ∈ Z")
case True
with A have "intv_const (I y) ≠ k y" unfolding I'_def by auto
with assms(8) A(2) have "intv_const (I y) < k y" by (fastforce elim!: valid_intv.cases)
with True A show ?thesis by (auto simp: r'_def)
next
case False
with A F have "I x = Intv d" "I y = Intv d'" by (auto simp: I'_def)
with A(1,2,5) total show ?thesis unfolding total_on_def r'_def by auto
qed
qed
qed
show "trans r'" unfolding trans_def
proof safe
fix x y z assume A: "(x, y) ∈ r'" "(y, z) ∈ r'"
show "(x, z) ∈ r'"
proof (cases "(x,y) ∈ r")
case True
then have "y ∉ Z" using refl unfolding Z_def refl_on_def by auto
then have "(y, z) ∈ r" using A unfolding r'_def by auto
with trans True show ?thesis unfolding trans_def r'_def by blast
next
case False
with A(1) have F: "x ∈ Z" "intv_const (I x) < k x" unfolding r'_def by auto
moreover from A(2) refl have "z ∈ X" "isIntv (I' z)"
by (auto simp: r'_def refl_on_def) (auto simp: I'_def Z_def)
ultimately show ?thesis unfolding r'_def by auto
qed
qed
show "∀x∈X. valid_intv (k x) (I' x)"
proof (auto simp: I'_def intro: valid, goal_cases)
case (1 x)
with assms(8) have "intv_const (I x) < k x" by (fastforce elim!: valid_intv.cases)
then show ?case by auto
qed
qed
lemma closest_prestable_2:
fixes I X k r
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
defines "R ≡ region X I r"
assumes "∀ x ∈ X. ¬ isConst (I x)"
defines "X⇩0 ≡ {x ∈ X. isIntv (I x)}"
defines "M ≡ {x ∈ X⇩0. ∀ y ∈ X⇩0. (x, y) ∈ r ⟶ (y, x) ∈ r}"
defines "I'≡ λ x. if x ∉ M then I x else Const (intv_const (I x) + 1)"
defines "r' ≡ {(x,y) ∈ r. x ∉ M ∧ y ∉ M}"
assumes "finite X"
assumes "valid_region X k I r"
assumes "M ≠ {}"
shows "∀ v ∈ R. ∀ t≥0. (v ⊕ t) ∉ R ⟶ (∃t'≤t. (v ⊕ t') ∈ region X I' r' ∧ t' ≥ 0)"
and "∀ v ∈ region X I' r'. ∀ t≥0. (v ⊕ t) ∉ R"
and "∀ v ∈ R. ∀ t'. {x. x ∈ X ∧ (∃ c. I' x = Intv c ∧ (v ⊕ t') x + (t - t') ≥ real (c + 1))}
= {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ real (c + 1))} - M"
and "∃ x ∈ X. isConst (I' x)"
proof (safe, goal_cases)
fix v assume v: "v ∈ R" fix t :: t assume t: "t ≥ 0" "(v ⊕ t) ∉ R"
note M = assms(10)
then obtain x c where x: "x ∈ M" "I x = Intv c" "x ∈ X" "x ∈ X⇩0" unfolding M_def X⇩0_def by force
let ?t = "1 - frac (v x)"
let ?v = "v ⊕ ?t"
have elem: "intv_elem x v (I x)" if "x ∈ X" for x using that v unfolding R_def by auto
from assms(9) have *: "trans r" "total_on {x ∈ X. ∃d. I x = Intv d} r" by auto
then have trans[intro]: "⋀x y z. (x, y) ∈ r ⟹ (y, z) ∈ r ⟹ (x, z) ∈ r" unfolding trans_def
by blast
have "{x ∈ X. ∃d. I x = Intv d} = X⇩0" unfolding X⇩0_def by auto
with *(2) have total: "total_on X⇩0 r" by auto
{ fix y assume y: "y ∉ M" "y ∈ X⇩0"
have "¬ (x, y) ∈ r" using x y unfolding M_def by auto
moreover with total x y have "(y, x) ∈ r" unfolding total_on_def by auto
ultimately have "¬ (x, y) ∈ r ∧ (y, x) ∈ r" ..
} note M_max = this
{ fix y assume T1: "y ∈ M" "x ≠ y"
then have T2: "y ∈ X⇩0" unfolding M_def by auto
with total x T1 have "(x, y) ∈ r ∨ (y, x) ∈ r" by (auto simp: total_on_def)
with T1(1) x(1) have "(x, y) ∈ r" "(y, x) ∈ r" unfolding M_def by auto
} note M_eq = this
{ fix y assume y: "y ∉ M" "y ∈ X⇩0"
with M_max have "¬ (x, y) ∈ r" "(y, x) ∈ r" by auto
with v[unfolded R_def] X⇩0_def x(4) y(2) have "frac (v y) < frac (v x)" by auto
then have "?t < 1 - frac (v y)" by auto
} note t_bound' = this
{ fix y assume y: "y ∈ X⇩0"
have "?t ≤ 1 - frac (v y)"
proof (cases "x = y")
case True thus ?thesis by simp
next
case False
have "(y, x) ∈ r"
proof (cases "y ∈ M")
case False with M_max y show ?thesis by auto
next
case True with False M_eq y show ?thesis by auto
qed
with v[unfolded R_def] X⇩0_def x(4) y have "frac (v y) ≤ frac (v x)" by auto
then show "?t ≤ 1 - frac (v y)" by auto
qed
} note t_bound''' = this
have "frac (v x) < 1" by (simp add: frac_lt_1)
then have "?t > 0" by (simp add: x(3))
{ fix c y fix t :: t assume y: "y ∉ M" "I y = Intv c" "y ∈ X" and t: "t ≥ 0" "t ≤ ?t"
then have "y ∈ X⇩0" unfolding X⇩0_def by auto
with t_bound' y have "?t < 1 - frac (v y)" by auto
with t have "t < 1 - frac (v y)" by auto
moreover from elem[OF ‹y ∈ X›] y have "c < v y" "v y < c + 1" by auto
ultimately have "(v y + t) < c + 1" using frac_add_le_preservation by blast
with ‹c < v y› t have "intv_elem y (v ⊕ t) (I y)" by (auto simp: cval_add_def y)
} note t_bound = this
from elem[OF x(3)] x(2) have v_x: "c < v x" "v x < c + 1" by auto
then have "floor (v x) = c" by linarith
then have shift: "v x + ?t = c + 1" unfolding frac_def by auto
have "v x + t ≥ c + 1"
proof (rule ccontr, goal_cases)
case 1
then have AA: "v x + t < c + 1" by simp
with shift have lt: "t < ?t" by auto
let ?v = "v ⊕ t"
have "?v ∈ region X I r"
proof (standard, goal_cases)
case 1
from v have "∀ x ∈ X. v x ≥ 0" unfolding R_def by auto
with t show ?case unfolding cval_add_def by auto
next
case 2
show ?case
proof (safe, goal_cases)
case (1 y)
note A = this
with elem have e: "intv_elem y v (I y)" by auto
show ?case
proof (cases "y ∈ M")
case False
then have [simp]: "I' y = I y" by (auto simp: I'_def)
show ?thesis
proof (cases "I y", goal_cases)
case 1 with assms(3) A show ?case by auto
next
case (2 c)
from t_bound[OF False this A t(1)] lt show ?case by (auto simp: cval_add_def 2)
next
case (3 c)
with e have "v y > c" by auto
with 3 t(1) show ?case by (auto simp: cval_add_def)
qed
next
case True
then have "y ∈ X⇩0" by (auto simp: M_def)
note T = this True
show ?thesis
proof (cases "x = y")
case False
with M_eq T have "(x, y) ∈ r" "(y, x) ∈ r" by presburger+
with v[unfolded R_def] X⇩0_def x(4) T(1) have *: "frac (v y) = frac (v x)" by auto
from T(1) obtain c where c: "I y = Intv c" by (auto simp: X⇩0_def)
with elem T(1) have "c < v y" "v y < c + 1" by (fastforce simp: X⇩0_def)+
then have "floor (v y) = c" by linarith
with * lt have "(v y + t) < c + 1" unfolding frac_def by auto
with ‹c < v y› t show ?thesis by (auto simp: c cval_add_def)
next
case True with ‹c < v x› t AA x show ?thesis by (auto simp: cval_add_def)
qed
qed
qed
next
show "X⇩0 = {x ∈ X. ∃d. I x = Intv d}" by (auto simp add: X⇩0_def)
next
have "t > 0"
proof (rule ccontr, goal_cases)
case 1 with t v show False unfolding cval_add_def by auto
qed
show "∀y∈X⇩0. ∀z∈X⇩0. ((y, z) ∈ r) = (frac ((v ⊕ t)y) ≤ frac ((v ⊕ t) z))"
proof (auto simp: X⇩0_def, goal_cases)
case (1 y z d d')
note A = this
from A have [simp]: "y ∈ X⇩0" "z ∈ X⇩0" unfolding X⇩0_def I'_def by auto
from A v[unfolded R_def] have le: "frac (v y) ≤ frac (v z)" by (auto simp: r'_def)
from t_bound''' have "?t ≤ 1 - frac (v y)" "?t ≤ 1 - frac (v z)" by auto
with lt have "t < 1 - frac (v y)" "t < 1 - frac (v z)" by auto
with frac_distr[OF ‹t > 0›] have
"frac (v y) + t = frac (v y + t)" "frac (v z) + t = frac (v z + t)"
by auto
with le show ?case by (auto simp: cval_add_def)
next
case (2 y z d d')
note A = this
from A have [simp]: "y ∈ X⇩0" "z ∈ X⇩0" unfolding X⇩0_def by auto
from t_bound''' have "?t ≤ 1 - frac (v y)" "?t ≤ 1 - frac (v z)" by auto
with lt have "t < 1 - frac (v y)" "t < 1 - frac (v z)" by auto
from frac_add_leD[OF ‹t > 0› this] A(5) have
"frac (v y) ≤ frac (v z)"
by (auto simp: cval_add_def)
with v[unfolded R_def] A show ?case by auto
qed
qed
with t R_def show False by simp
qed
with shift have "t ≥ ?t" by simp
let ?R = "region X I' r'"
let ?X⇩0 = "{x ∈ X. ∃d. I' x = Intv d}"
have "(v ⊕ ?t) ∈ ?R"
proof (standard, goal_cases)
case 1
from v have "∀ x ∈ X. v x ≥ 0" unfolding R_def by auto
with ‹?t > 0› t show ?case unfolding cval_add_def by auto
next
case 2
show ?case
proof (safe, goal_cases)
case (1 y)
note A = this
with elem have e: "intv_elem y v (I y)" by auto
show ?case
proof (cases "y ∈ M")
case False
then have [simp]: "I' y = I y" by (auto simp: I'_def)
show ?thesis
proof (cases "I y", goal_cases)
case 1 with assms(3) A show ?case by auto
next
case (2 c)
from t_bound[OF False this A] ‹?t > 0› show ?case by (auto simp: cval_add_def 2)
next
case (3 c)
with e have "v y > c" by auto
with 3 ‹?t > 0› show ?case by (auto simp: cval_add_def)
qed
next
case True
then have "y ∈ X⇩0" by (auto simp: M_def)
note T = this True
show ?thesis
proof (cases "x = y")
case False
with M_eq T(2) have "(x, y) ∈ r" "(y, x) ∈ r" by auto
with v[unfolded R_def] X⇩0_def x(4) T(1) have *: "frac (v y) = frac (v x)" by auto
from T(1) obtain c where c: "I y = Intv c" by (auto simp: X⇩0_def)
with elem T(1) have "c < v y" "v y < c + 1" by (fastforce simp: X⇩0_def)+
then have "floor (v y) = c" by linarith
with * have "(v y + ?t) = c + 1" unfolding frac_def by auto
with T(2) show ?thesis by (auto simp: c cval_add_def I'_def)
next
case True with shift x show ?thesis by (auto simp: cval_add_def I'_def)
qed
qed
qed
next
show "?X⇩0 = ?X⇩0" ..
next
show "∀y∈?X⇩0. ∀z∈?X⇩0. ((y, z) ∈ r') = (frac ((v ⊕ 1 - frac (v x))y) ≤ frac ((v ⊕ 1 - frac (v x)) z))"
proof (safe, goal_cases)
case (1 y z d d')
note A = this
then have "y ∉ M" "z ∉ M" unfolding I'_def by auto
with A have [simp]: "I' y = I y" "I' z = I z" "y ∈ X⇩0" "z ∈ X⇩0" unfolding X⇩0_def I'_def by auto
from A v[unfolded R_def] have le: "frac (v y) ≤ frac (v z)" by (auto simp: r'_def)
from t_bound' ‹y ∉ M› ‹z ∉ M› have "?t < 1 - frac (v y)" "?t < 1 - frac (v z)" by auto
with frac_distr[OF ‹?t > 0›] have
"frac (v y) + ?t = frac (v y + ?t)" "frac (v z) + ?t = frac (v z + ?t)"
by auto
with le show ?case by (auto simp: cval_add_def)
next
case (2 y z d d')
note A = this
then have M: "y ∉ M" "z ∉ M" unfolding I'_def by auto
with A have [simp]: "I' y = I y" "I' z = I z" "y ∈ X⇩0" "z ∈ X⇩0" unfolding X⇩0_def I'_def by auto
from t_bound' ‹y ∉ M› ‹z ∉ M› have "?t < 1 - frac (v y)" "?t < 1 - frac (v z)" by auto
from frac_add_leD[OF ‹?t > 0› this] A(5) have
"frac (v y) ≤ frac (v z)"
by (auto simp: cval_add_def)
with v[unfolded R_def] A M show ?case by (auto simp: r'_def)
qed
qed
with ‹?t > 0› ‹?t ≤ t› show "∃t'≤t. (v ⊕ t') ∈ region X I' r' ∧ 0 ≤ t'" by auto
next
fix v t assume A: "v ∈ region X I' r'" "0 ≤ t" "(v ⊕ t) ∈ R"
from assms(10) obtain x c where x:
"x ∈ X⇩0" "I x = Intv c" "x ∈ X" "x ∈ M"
unfolding M_def X⇩0_def by force
with A(1) have "intv_elem x v (I' x)" by auto
with x have "v x = c + 1" unfolding I'_def by auto
moreover from A(3) x(2,3) have "v x + t < c + 1" by (fastforce simp: cval_add_def R_def)
ultimately show False using A(2) by auto
next
case A: (3 v t' x c)
from A(3) have "I x = Intv c" by (auto simp: I'_def) (cases "x ∈ M", auto)
with A(4) show ?case by (auto simp: cval_add_def)
next
case 4
then show ?case unfolding I'_def by auto
next
case A: (5 v t' x c)
then have "I' x = Intv c" unfolding I'_def by auto
moreover from A have "real (c + 1) ≤ (v ⊕ t') x + (t - t')" by (auto simp: cval_add_def)
ultimately show ?case by blast
next
from assms(5,10) obtain x where x: "x ∈ M" by blast
then have "isConst (I' x)" by (auto simp: I'_def)
with x show "∃x∈X. isConst (I' x)" unfolding M_def X⇩0_def by force
qed
lemma closest_valid_2:
fixes I X k r
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
defines "R ≡ region X I r"
assumes "∀ x ∈ X. ¬ isConst (I x)"
defines "X⇩0 ≡ {x ∈ X. isIntv (I x)}"
defines "M ≡ {x ∈ X⇩0. ∀ y ∈ X⇩0. (x, y) ∈ r ⟶ (y, x) ∈ r}"
defines "I'≡ λ x. if x ∉ M then I x else Const (intv_const (I x) + 1)"
defines "r' ≡ {(x,y) ∈ r. x ∉ M ∧ y ∉ M}"
assumes "finite X"
assumes "valid_region X k I r"
assumes "M ≠ {}"
shows "valid_region X k I' r'"
proof
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
let ?X⇩0' = "{x ∈ X. ∃d. I' x = Intv d}"
show "?X⇩0' = ?X⇩0'" ..
from assms(9) have refl: "refl_on ?X⇩0 r" and total: "total_on ?X⇩0 r" and trans: "trans r"
and valid: "⋀ x. x ∈ X ⟹ valid_intv (k x) (I x)"
by auto
have subs: "r' ⊆ r" unfolding r'_def by auto
from refl have "r ⊆ ?X⇩0 × ?X⇩0" unfolding refl_on_def by auto
then have "r'⊆ ?X⇩0' × ?X⇩0'" unfolding r'_def I'_def by auto
then show "refl_on ?X⇩0' r'" unfolding refl_on_def
proof auto
fix x d assume A: "x ∈ X" "I' x = Intv d"
then have "x ∉ M" by (force simp: I'_def)
with A have "I x = Intv d" by (force simp: I'_def)
with A refl have "(x,x) ∈ r" by (auto simp: refl_on_def)
then show "(x, x) ∈ r'" by (auto simp: r'_def ‹x ∉ M›)
qed
show "total_on ?X⇩0' r'" unfolding total_on_def
proof (safe, goal_cases)
case (1 x y d d')
note A = this
then have *: "x ∉ M" "y ∉ M" by (force simp: I'_def)+
with A have "I x = Intv d" "I y = Intv d'" by (force simp: I'_def)+
with A total have "(x, y) ∈ r ∨ (y, x) ∈ r" by (auto simp: total_on_def)
with A(6) * show ?case unfolding r'_def by auto
qed
show "trans r'" unfolding trans_def
proof safe
fix x y z assume A: "(x, y) ∈ r'" "(y, z) ∈ r'"
from trans have [intro]:
"⋀ x y z. (x,y) ∈ r ⟹ (y, z) ∈ r ⟹ (x, z) ∈ r"
unfolding trans_def by blast
from A show "(x, z) ∈ r'" by (auto simp: r'_def)
qed
show "∀x∈X. valid_intv (k x) (I' x)"
using valid unfolding I'_def
proof (auto simp: I'_def intro: valid, goal_cases)
case (1 x)
with assms(9) have "intv_const (I x) < k x" by (fastforce simp: M_def X⇩0_def)
then show ?case by auto
qed
qed
subsection ‹Putting the Proof for the 'Set of Regions' Property Together›
subsubsection ‹Misc›
lemma total_finite_trans_max:
"X ≠ {} ⟹ finite X ⟹ total_on X r ⟹ trans r ⟹ ∃ x ∈ X. ∀ y ∈ X. x ≠ y ⟶ (y, x) ∈ r"
proof (induction "card X" arbitrary: X)
case 0
then show ?case by auto
next
case (Suc n)
then obtain x where x: "x ∈ X" by blast
show ?case
proof (cases "n = 0")
case True
with Suc.hyps(2) ‹finite X› x have "X = {x}" by (metis card_Suc_eq empty_iff insertE)
then show ?thesis by auto
next
case False
show ?thesis
proof (cases "∀y∈X. x ≠ y ⟶ (y, x) ∈ r")
case True with x show ?thesis by auto
next
case False
then obtain y where y: "y ∈ X" "x ≠ y" "¬ (y, x) ∈ r" by auto
with x Suc.prems(3) have "(x, y) ∈ r" unfolding total_on_def by blast
let ?X = "X - {x}"
have tot: "total_on ?X r" using ‹total_on X r› unfolding total_on_def by auto
from x Suc.hyps(2) ‹finite X› have card: "n = card ?X" by auto
with ‹finite X› ‹n ≠ 0› have "?X ≠ {}" by auto
from Suc.hyps(1)[OF card this _ tot ‹trans r›] ‹finite X› obtain x' where
IH: "x' ∈ ?X" "∀ y ∈ ?X. x' ≠ y ⟶ (y, x') ∈ r"
by auto
have "(x', x) ∉ r"
proof (rule ccontr, auto)
assume A: "(x', x) ∈ r"
with y(3) have "x' ≠ y" by auto
with y IH have "(y, x') ∈ r" by auto
with ‹trans r› A have "(y, x) ∈ r" unfolding trans_def by blast
with y show False by auto
qed
with ‹x ∈ X› ‹x' ∈ ?X› ‹total_on X r› have "(x, x') ∈ r" unfolding total_on_def by auto
with IH show ?thesis by auto
qed
qed
qed
lemma card_mono_strict_subset:
"finite A ⟹ finite B ⟹ finite C ⟹ A ∩ B ≠ {} ⟹ C = A - B ⟹ card C < card A"
by (metis Diff_disjoint Diff_subset inf_commute less_le psubset_card_mono)
subsubsection ‹Proof›
text ‹
First we show that a shift by a non-negative integer constant means that any two valuations from
the same region are being shifted to the same region.
›
lemma int_shift_equiv:
fixes X k fixes t :: int
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "v ∈ R" "v' ∈ R" "R ∈ ℛ" "t ≥ 0"
shows "(v' ⊕ t) ∈ [v ⊕ t]⇩ℛ" using assms
proof -
from assms obtain I r where A: "R = region X I r" "valid_region X k I r" by auto
from regions_closed[OF _ assms(4,2), of X k t] assms(1,5) obtain I' r' where RR:
"[v ⊕ t]⇩ℛ = region X I' r'" "valid_region X k I' r'"
by auto
from regions_closed'[OF _ assms(4,2), of X k t] assms(1,5) have RR': "(v ⊕ t) ∈ [v ⊕ t]⇩ℛ" by auto
show ?thesis
proof (simp add: RR(1), rule, goal_cases)
case 1
from ‹v' ∈ R› A(1) have "∀x∈X. 0 ≤ v' x" by auto
with ‹t ≥ 0› show ?case unfolding cval_add_def by auto
next
case 2
show ?case
proof safe
fix x assume x: "x ∈ X"
with ‹v' ∈ R› ‹v ∈ R› A(1) have I: "intv_elem x v (I x)" "intv_elem x v' (I x)" by auto
from x RR RR' have I': "intv_elem x (v ⊕ t) (I' x)" by auto
show "intv_elem x (v' ⊕ t) (I' x)"
proof (cases "I' x")
case (Const c)
from Const I' have "v x + t = c" unfolding cval_add_def by auto
with x A(1) ‹v ∈ R› ‹t ≥ 0› have *: "v x = c - nat t" "t ≤ c" by fastforce+
with ‹t ≥ 0› I(1) have "I x = Const (c - nat t)"
proof (cases "I x", auto)
case (Greater c')
from RR(2) Const ‹x ∈ X› have "c ≤ k x" by fastforce
with Greater * ‹t ≥ 0› have *: "v x ≤ k x" by auto
from Greater A(2) ‹x ∈ X› have "c' = k x" by fastforce
moreover from I(1) Greater have "v x > c'" by auto
ultimately show False using ‹c ≤ k x› * by auto
qed
with I ‹t ≥ 0› *(2) have "v' x + t = c" by auto
with Const show ?thesis unfolding cval_add_def by auto
next
case (Intv c)
with I' have "c < v x + t" "v x + t < c + 1" unfolding cval_add_def by auto
with x A(1) ‹v ∈ R› ‹t ≥ 0› have
*: "c - nat t < v x" "v x < c - nat t + 1" "t ≤ c"
by fastforce+
with I have "I x = Intv (c - nat t)"
proof (cases "I x", auto)
case (Greater c')
from RR(2) Intv ‹x ∈ X› have "c < k x" by fastforce
with Greater * have *: "v x ≤ k x" by auto
from Greater A(2) ‹x ∈ X› have "c' = k x" by fastforce
moreover from I(1) Greater have "v x > c'" by auto
ultimately show False using ‹c < k x› * by auto
qed
with I ‹t ≤ c› have "c < v' x + nat t" "v' x + t < c + 1" by auto
with Intv ‹t ≥ 0› show ?thesis unfolding cval_add_def by auto
next
case (Greater c)
with I' have *: "c < v x + t" unfolding cval_add_def by auto
show ?thesis
proof (cases "I x")
case (Const c')
with x A(1) I(2) ‹v ∈ R› ‹v' ∈ R› have "v x = v' x" by fastforce
with Greater * show ?thesis unfolding cval_add_def by auto
next
case (Intv c')
with x A(1) I(2) ‹v ∈ R› ‹v' ∈ R› have **: "c' < v x" "v x < c' + 1" "c' < v' x"
by fastforce+
then have "c' + t < v x + t" "v x + t < c' + t + 1" by auto
with * have "c ≤ c' + t" by auto
with **(3) have "v' x + t > c" by auto
with Greater * show ?thesis unfolding cval_add_def by auto
next
fix c' assume c': "I x = Greater c'"
with x A(1) I(2) ‹v ∈ R› ‹v' ∈ R› have **: "c' < v x" "c' < v' x" by fastforce+
from Greater RR(2) c' A(2) ‹x ∈ X› have "c' = k x" "c = k x" by fastforce+
with ‹t ≥ 0› **(2) Greater show "intv_elem x (v' ⊕ real_of_int t) (I' x)"
unfolding cval_add_def by auto
qed
qed
qed
next
show "{x ∈ X. ∃d. I' x = Intv d} = {x ∈ X. ∃d. I' x = Intv d}" ..
next
let ?X⇩0 = "{x ∈ X. ∃d. I' x = Intv d}"
{ fix x y :: real
have "frac (x + t) ≤ frac (y + t) ⟷ frac x ≤ frac y" by (simp add: frac_def)
} note frac_equiv = this
{ fix x y
have "frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y) ⟷ frac (v x) ≤ frac (v y)"
unfolding cval_add_def using frac_equiv by auto
} note frac_equiv' = this
{ fix x y
have "frac ((v' ⊕ t) x) ≤ frac ((v' ⊕ t) y) ⟷ frac (v' x) ≤ frac (v' y)"
unfolding cval_add_def using frac_equiv by auto
} note frac_equiv'' = this
{ fix x y assume x: "x ∈ X" and y: "y ∈ X" and B: "¬ isGreater(I x)" "¬ isGreater(I y)"
have "frac (v x) ≤ frac (v y) ⟷ frac (v' x) ≤ frac (v' y)"
proof (cases "I x")
case (Const c)
with x ‹v ∈ R› ‹v' ∈ R› A(1) have "v x = c" "v' x = c" by fastforce+
then have "frac (v x) ≤ frac (v y)" "frac (v' x) ≤ frac (v' y)" by(simp add: frac_def)+
then show ?thesis by auto
next
case (Intv c)
with x ‹v ∈ R› A(1) have v: "c < v x" "v x < c + 1" by fastforce+
from Intv x ‹v' ∈ R› A(1) have v':"c < v' x" "v' x < c + 1" by fastforce+
show ?thesis
proof (cases "I y", goal_cases)
case (Const c')
with y ‹v ∈ R› ‹v' ∈ R› A(1) have "v y = c'" "v' y = c'" by fastforce+
then have "frac (v y) = 0" "frac (v' y) = 0" by auto
with nat_intv_frac_gt0[OF v] nat_intv_frac_gt0[OF v']
have "¬ frac (v x) ≤ frac (v y)" "¬ frac (v' x) ≤ frac (v' y)" by linarith+
then show ?thesis by auto
next
case 2: (Intv c')
with x y Intv ‹v ∈ R› ‹v' ∈ R› A(1) have
"(x, y) ∈ r ⟷ frac (v x) ≤ frac (v y)"
"(x, y) ∈ r ⟷ frac (v' x) ≤ frac (v' y)"
by auto
then show ?thesis by auto
next
case Greater
with B show ?thesis by auto
qed
next
case Greater with B show ?thesis by auto
qed
} note frac_cong = this
have not_greater: "¬ isGreater (I x)" if x: "x ∈ X" "¬ isGreater (I' x)" for x
proof (rule ccontr, auto, goal_cases)
case (1 c)
with x ‹v ∈ R› A(1,2) have "c < v x" by fastforce+
moreover from x A(2) 1 have "c = k x" by fastforce+
ultimately have *: "k x < v x + t" using ‹t ≥ 0› by simp
from RR(1,2) RR' x have I': "intv_elem x (v ⊕ t) (I' x)" "valid_intv (k x) (I' x)" by auto
from x show False
proof (cases "I' x", auto)
case (Const c')
with I' * show False by (auto simp: cval_add_def)
next
case (Intv c')
with I' * show False by (auto simp: cval_add_def)
qed
qed
show "∀ x ∈ ?X⇩0. ∀y ∈ ?X⇩0. ((x, y) ∈ r') = (frac ((v' ⊕ t) x) ≤ frac ((v' ⊕ t) y))"
proof (standard, standard)
fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
then have B: "¬ isGreater (I' x)" "¬ isGreater (I' y)" by auto
with x y not_greater have "¬ isGreater (I x)" "¬ isGreater (I y)" by auto
with x y frac_cong have "frac (v x) ≤ frac (v y) ⟷ frac (v' x) ≤ frac (v' y)" by auto
moreover from x y RR(1) RR' have "(x, y) ∈ r' ⟷ frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y)"
by fastforce
ultimately show "(x, y) ∈ r' ⟷ frac ((v' ⊕ t) x) ≤ frac ((v' ⊕ t) y)"
using frac_equiv' frac_equiv'' by blast
qed
qed
qed
text ‹
Now, we can use the 'immediate' induction proposed by P. Bouyer for shifts smaller than one.
The induction principle is not at all obvious: the induction is over the set of clocks for
which the valuation is shifted beyond the current interval boundaries.
Using the two successor operations, we can see that either the set of these clocks remains the
same (Z ~= {}) or strictly decreases (Z = {}).
›
lemma set_of_regions_lt_1:
fixes X k I r t v
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
defines "C ≡ {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ c + 1)}"
assumes "valid_region X k I r" "v ∈ region X I r" "v' ∈ region X I r" "finite X" "0 ≤ t" "t < 1"
shows "∃ t'≥0. (v' ⊕ t') ∈ [v ⊕ t]⇩ℛ" using assms
proof (induction "card C" arbitrary: C I r v v' t rule: less_induct)
case less
let ?R = "region X I r"
let ?C = "{x ∈ X. ∃c. I x = Intv c ∧ real (c + 1) ≤ v x + t}"
from less have R: "?R ∈ ℛ" by auto
{ fix v I k r fix t :: t
assume no_consts: "∀x∈X. ¬isConst (I x)"
assume v: "v ∈ region X I r"
assume t: "t ≥ 0"
let ?C = "{x ∈ X. ∃c. I x = Intv c ∧ real (c + 1) ≤ v x + t}"
assume C: "?C = {}"
let ?R = "region X I r"
have "(v ⊕ t) ∈ ?R"
proof (rule, goal_cases)
case 1
with ‹t ≥ 0› ‹v ∈ ?R› show ?case by (auto simp: cval_add_def)
next
case 2
show ?case
proof (standard, case_tac "I x", goal_cases)
case (1 x c)
with no_consts show ?case by auto
next
case (2 x c)
with ‹v ∈ ?R› have "c < v x" by fastforce
with ‹t ≥ 0› have "c < v x + t" by auto
moreover from 2 C have "v x + t < c + 1" by fastforce
ultimately show ?case by (auto simp: 2 cval_add_def)
next
case (3 x c)
with ‹v ∈ ?R› have "c < v x" by fastforce
with ‹t ≥ 0› have "c < v x + t" by auto
then show ?case by (auto simp: 3 cval_add_def)
qed
next
show "{x ∈ X. ∃d. I x = Intv d} = {x ∈ X. ∃d. I x = Intv d}" ..
next
let ?X⇩0 = "{x ∈ X. ∃d. I x = Intv d}"
{ fix x d :: real fix c:: nat assume A: "c < x" "x + d < c + 1" "d ≥ 0"
then have "d < 1 - frac x" unfolding frac_def using floor_eq3 of_nat_Suc by fastforce
} note intv_frac = this
{ fix x assume x: "x ∈ ?X⇩0"
then obtain c where x: "x ∈ X" "I x = Intv c" by auto
with ‹v ∈ ?R› have *: "c < v x" by fastforce
with ‹t ≥ 0› have "c < v x + t" by auto
from x C have "v x + t < c + 1" by auto
from intv_frac[OF * this ‹t ≥ 0›] have "t < 1 - frac (v x) " by auto
} note intv_frac = this
{ fix x y assume x: "x ∈ ?X⇩0" and y: "y ∈ ?X⇩0"
from frac_add_leIFF[OF ‹t ≥ 0› intv_frac[OF x] intv_frac[OF y]]
have "frac (v x) ≤ frac (v y) ⟷ frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y)"
by (auto simp: cval_add_def)
} note frac_cong = this
show "∀ x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r ⟷ frac ((v ⊕ t) x) ≤ frac ((v ⊕ t) y)"
proof (standard, standard, goal_cases)
case (1 x y)
with ‹v ∈ ?R› have "(x, y) ∈ r ⟷ frac (v x) ≤ frac (v y)" by auto
with frac_cong[OF 1] show ?case by simp
qed
qed
} note critical_empty_intro = this
{ assume const: "∃x∈X. isConst (I x)"
assume t: "t > 0"
from const have "{x ∈ X. ∃c. I x = Const c} ≠ {}" by auto
from closest_prestable_1[OF this less.prems(4) less(3)] R closest_valid_1[OF this less.prems(4) less(3)]
obtain I'' r''
where stability: "∀ v ∈ ?R. ∀ t>0. ∃t'≤t. (v ⊕ t') ∈ region X I'' r'' ∧ t' ≥ 0"
and succ_not_refl: "∀ v ∈ region X I'' r''. ∀ t≥0. (v ⊕ t) ∉ ?R"
and no_consts: "∀ x ∈ X. ¬ isConst (I'' x)"
and crit_mono: "∀ v ∈ ?R. ∀ t < 1. ∀ t' ≥ 0. (v ⊕ t') ∈ region X I'' r''
⟶ {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ c + 1)}
= {x. x ∈ X ∧ (∃ c. I'' x = Intv c ∧ (v ⊕ t') x + (t - t') ≥ c + 1)}"
and succ_valid: "valid_region X k I'' r''"
by auto
let ?R'' = "region X I'' r''"
from stability less(4) ‹t > 0› obtain t1 where t1: "t1 ≥ 0" "t1 ≤ t" "(v ⊕ t1) ∈ ?R''" by auto
from stability less(5) ‹t > 0› obtain t2 where t2: "t2 ≥ 0" "t2 ≤ t" "(v' ⊕ t2) ∈ ?R''" by auto
let ?v = "v ⊕ t1"
let ?t = "t - t1"
let ?C' = "{x ∈ X. ∃c. I'' x = Intv c ∧ real (c + 1) ≤ ?v x + ?t}"
from t1 ‹t < 1› have tt: "0 ≤ ?t" "?t < 1" by auto
from crit_mono ‹t < 1› t1(1,3) ‹v ∈ ?R› have crit:
"?C = ?C'"
by auto
with t1 t2 succ_valid no_consts have
"∃ t1 ≥ 0. ∃ t2 ≥ 0. ∃ I' r'. t1 ≤ t ∧ (v ⊕ t1) ∈ region X I' r'
∧ t2 ≤ t ∧ (v' ⊕ t2) ∈ region X I' r'
∧ valid_region X k I' r'
∧ (∀ x ∈ X. ¬ isConst (I' x))
∧ ?C = {x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ (v ⊕ t1) x + (t - t1)}"
by blast
} note const_dest = this
{ fix t :: real fix v I r x c v'
let ?R = "region X I r"
assume v: "v ∈ ?R"
assume v': "v' ∈ ?R"
assume valid: "valid_region X k I r"
assume t: "t > 0" "t < 1"
let ?C = "{x ∈ X. ∃c. I x = Intv c ∧ real (c + 1) ≤ v x + t}"
assume C: "?C = {}"
assume const: "∃ x ∈ X. isConst (I x)"
then have "{x ∈ X. ∃c. I x = Const c} ≠ {}" by auto
from closest_prestable_1[OF this less.prems(4) valid] R closest_valid_1[OF this less.prems(4) valid]
obtain I'' r''
where stability: "∀ v ∈ ?R. ∀ t>0. ∃t'≤t. (v ⊕ t') ∈ region X I'' r'' ∧ t' ≥ 0"
and succ_not_refl: "∀ v ∈ region X I'' r''. ∀ t≥0. (v ⊕ t) ∉ ?R"
and no_consts: "∀ x ∈ X. ¬ isConst (I'' x)"
and crit_mono: "∀ v ∈ ?R. ∀ t < 1. ∀ t' ≥ 0. (v ⊕ t') ∈ region X I'' r''
⟶ {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ c + 1)}
= {x. x ∈ X ∧ (∃ c. I'' x = Intv c ∧ (v ⊕ t') x + (t - t') ≥ c + 1)}"
and succ_valid: "valid_region X k I'' r''"
by auto
let ?R'' = "region X I'' r''"
from stability v ‹t > 0› obtain t1 where t1: "t1 ≥ 0" "t1 ≤ t" "(v ⊕ t1) ∈ ?R''" by auto
from stability v' ‹t > 0› obtain t2 where t2: "t2 ≥ 0" "t2 ≤ t" "(v' ⊕ t2) ∈ ?R''" by auto
let ?v = "v ⊕ t1"
let ?t = "t - t1"
let ?C' = "{x ∈ X. ∃c. I'' x = Intv c ∧ real (c + 1) ≤ ?v x + ?t}"
from t1 ‹t < 1› have tt: "0 ≤ ?t" "?t < 1" by auto
from crit_mono ‹t < 1› t1(1,3) ‹v ∈ ?R› have crit:
"{x ∈ X. ∃c. I x = Intv c ∧ real (c + 1) ≤ v x + t}
= {x ∈ X. ∃c. I'' x = Intv c ∧ real (c + 1) ≤ (v ⊕ t1) x + (t - t1)}"
by auto
with C have C: "?C' = {}" by blast
from critical_empty_intro[OF no_consts t1(3) tt(1) this] have "((v ⊕ t1) ⊕ ?t) ∈ ?R''" .
from region_unique[OF less(2) this] less(2) succ_valid t2 have "∃t'≥0. (v' ⊕ t') ∈ [v ⊕ t]⇩ℛ"
by (auto simp: cval_add_def)
} note intro_const = this
{ fix v I r t x c v'
let ?R = "region X I r"
assume v: "v ∈ ?R"
assume v': "v' ∈ ?R"
assume F2: "∀x∈X. ¬isConst (I x)"
assume x: "x ∈ X" "I x = Intv c" "v x + t ≥ c + 1"
assume valid: "valid_region X k I r"
assume t: "t ≥ 0" "t < 1"
let ?C' = "{x ∈ X. ∃c. I x = Intv c ∧ real (c + 1) ≤ v x + t}"
assume C: "?C = ?C'"
have not_in_R: "(v ⊕ t) ∉ ?R"
proof (rule ccontr, auto)
assume "(v ⊕ t) ∈ ?R"
with x(1,2) have "v x + t < c + 1" by (fastforce simp: cval_add_def)
with x(3) show False by simp
qed
have not_in_R': "(v' ⊕ 1) ∉ ?R"
proof (rule ccontr, auto)
assume "(v' ⊕ 1) ∈ ?R"
with x have "v' x + 1 < c + 1" by (fastforce simp: cval_add_def)
moreover from x v' have "c < v' x" by fastforce
ultimately show False by simp
qed
let ?X⇩0 = "{x ∈ X. isIntv (I x)}"
let ?M = "{x ∈ ?X⇩0. ∀y∈?X⇩0. (x, y) ∈ r ⟶ (y, x) ∈ r}"
from x have x: "x ∈ X" "¬ isGreater (I x)" and c: "I x = Intv c" by auto
with ‹x ∈ X› have *: "?X⇩0 ≠ {}" by auto
have "?X⇩0 = {x ∈ X. ∃d. I x = Intv d}" by auto
with valid have r: "total_on ?X⇩0 r" "trans r" by auto
from total_finite_trans_max[OF * _ this] ‹finite X›
obtain x' where x': "x' ∈ ?X⇩0" "∀ y ∈ ?X⇩0. x' ≠ y ⟶ (y, x') ∈ r" by fastforce
from this(2) have "∀y∈?X⇩0. (x', y) ∈ r ⟶ (y, x') ∈ r" by auto
with x'(1) have "?M ≠ {}" by fastforce
from closest_prestable_2[OF F2 less.prems(4) valid this] closest_valid_2[OF F2 less.prems(4) valid this]
obtain I' r'
where stability:
"∀ v ∈ region X I r. ∀ t≥0. (v ⊕ t) ∉ region X I r ⟶ (∃t'≤t. (v ⊕ t') ∈ region X I' r' ∧ t' ≥ 0)"
and succ_not_refl: "∀ v ∈ region X I' r'. ∀ t≥0. (v ⊕ t) ∉ region X I r"
and critical_mono: "∀ v ∈ region X I r. ∀t. ∀ t'.
{x. x ∈ X ∧ (∃ c. I' x = Intv c ∧ (v ⊕ t') x + (t - t') ≥ real (c + 1))}
= {x. x ∈ X ∧ (∃ c. I x = Intv c ∧ v x + t ≥ real (c + 1))} - ?M"
and const_ex: "∃x∈X. isConst (I' x)"
and succ_valid: "valid_region X k I' r'"
by auto
let ?R' = "region X I' r'"
from not_in_R stability ‹t ≥ 0› v obtain t' where
t': "t' ≥ 0" "t' ≤ t" "(v ⊕ t') ∈ ?R'"
by blast
have "(1::t) ≥ 0" by auto
with not_in_R' stability v' obtain t1 where
t1: "t1 ≥ 0" "t1 ≤ 1" "(v' ⊕ t1) ∈ ?R'"
by blast
let ?v = "v ⊕ t'"
let ?t = "t - t'"
let ?C'' = "{x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ ?v x + ?t}"
have "∃t'≥0. (v' ⊕ t') ∈ [v ⊕ t]⇩ℛ"
proof (cases "t = t'")
case True
with t' have "(v ⊕ t) ∈ ?R'" by auto
from region_unique[OF less(2) this] succ_valid ℛ_def have "[v ⊕ t]⇩ℛ = ?R'" by blast
with t1(1,3) show ?thesis by auto
next
case False
with ‹t < 1› t' have tt: "0 ≤ ?t" "?t < 1" "?t > 0" by auto
from critical_mono ‹v ∈ ?R› have C_eq: "?C'' = ?C' - ?M" by auto
show "∃t'≥0. (v' ⊕ t') ∈ [v ⊕ t]⇩ℛ"
proof (cases "?C' ∩ ?M = {}")
case False
from ‹finite X› have "finite ?C''" "finite ?C'" "finite ?M" by auto
then have "card ?C'' < card ?C" using C_eq C False by (intro card_mono_strict_subset) auto
from less(1)[OF this less(2) succ_valid t'(3) t1(3) ‹finite X› tt(1,2)]
obtain t2 where "t2 ≥ 0" "((v' ⊕ t1) ⊕ t2) ∈ [(v ⊕ t)]⇩ℛ" by (auto simp: cval_add_def)
moreover have "(v' ⊕ (t1 + t2)) = ((v' ⊕ t1) ⊕ t2)" by (auto simp: cval_add_def)
moreover have "t1 + t2 ≥ 0" using ‹t2 ≥ 0› t1(1) by auto
ultimately show ?thesis by metis
next
case True
{ fix x c assume x: "x ∈ X" "I x = Intv c" "real (c + 1) ≤ v x + t"
with True have "x ∉ ?M" by force
from x have "x ∈ ?X⇩0" by auto
from x(1,2) ‹v ∈ ?R› have *: "c < v x" "v x < c + 1" by fastforce+
with ‹t < 1› have "v x + t < c + 2" by auto
have ge_1: "frac (v x) + t ≥ 1"
proof (rule ccontr, goal_cases)
case 1
then have A: "frac (v x) + t < 1" by auto
from * have "floor (v x) + frac (v x) < c + 1" unfolding frac_def by auto
with nat_intv_frac_gt0[OF *] have "floor (v x) ≤ c" by linarith
with A have "v x + t < c + 1" by (auto simp: frac_def)
with x(3) show False by auto
qed
from ‹?M ≠ {}› obtain y where "y ∈ ?M" by force
with ‹x ∈ ?X⇩0› have y: "y ∈ ?X⇩0" "(y, x) ∈ r ⟶ (x, y) ∈ r" by auto
from y obtain c' where c': "y ∈ X" "I y = Intv c'" by auto
with ‹v ∈ ?R› have "c' < v y" by fastforce
from ‹y ∈ ?M› ‹x ∉ ?M› have "x ≠ y" by auto
with y r(1) x(1,2) have "(x, y) ∈ r" unfolding total_on_def by fastforce
with ‹v ∈ ?R› c' x have "frac (v x) ≤ frac (v y)" by fastforce
with ge_1 have frac: "frac (v y) + t ≥ 1" by auto
have "real (c' + 1) ≤ v y + t"
proof (rule ccontr, goal_cases)
case 1
from ‹c' < v y› have "floor (v y) ≥ c'" by linarith
with frac have "v y + t ≥ c' + 1" unfolding frac_def by linarith
with 1 show False by simp
qed
with c' True ‹y ∈ ?M› have False by auto
}
then have C: "?C' = {}" by auto
with C_eq have C'': "?C'' = {}" by auto
from intro_const[OF t'(3) t1(3) succ_valid tt(3) tt(2) C'' const_ex]
obtain t2 where "t2 ≥ 0" "((v' ⊕ t1) ⊕ t2) ∈ [v ⊕ t]⇩ℛ" by (auto simp: cval_add_def)
moreover have "(v' ⊕ (t1 + t2)) = ((v' ⊕ t1) ⊕ t2)" by (auto simp: cval_add_def)
moreover have "t1 + t2 ≥ 0" using ‹t2 ≥ 0› t1(1) by auto
ultimately show ?thesis by metis
qed
qed
} note intro_intv = this
from regions_closed[OF less(2) R less(4,7)] less(2) obtain I' r' where R':
"[v ⊕ t]⇩ℛ = region X I' r'" "valid_region X k I' r'"
by auto
with regions_closed'[OF less(2) R less(4,7)] assms(1) have
R'2: "(v ⊕ t) ∈ [v ⊕ t]⇩ℛ" "(v ⊕ t) ∈ region X I' r'"
by auto
let ?R' = "region X I' r'"
from less(2) R' have "?R' ∈ ℛ" by auto
show ?case
proof (cases "?R' = ?R")
case True with less(3,5) R'(1) have "(v' ⊕ 0) ∈ [v ⊕ t]⇩ℛ" by (auto simp: cval_add_def)
then show ?thesis by auto
next
case False
have "t > 0"
proof (rule ccontr)
assume "¬ 0 < t"
with R' ‹t ≥ 0› have "[v]⇩ℛ = ?R'" by (simp add: cval_add_def)
with region_unique[OF less(2) less(4) R] ‹?R' ≠ ?R› show False by auto
qed
show ?thesis
proof (cases "?C = {}")
case True
show ?thesis
proof (cases "∃ x ∈ X. isConst (I x)")
case False
then have no_consts: "∀x∈X. ¬isConst (I x)" by auto
from critical_empty_intro[OF this ‹v ∈ ?R› ‹t ≥ 0› True] have "(v ⊕ t) ∈ ?R" .
from region_unique[OF less(2) this R] less(5) have "(v' ⊕ 0) ∈ [v ⊕ t]⇩ℛ"
by (auto simp: cval_add_def)
then show ?thesis by blast
next
case True
from const_dest[OF this ‹t > 0›] obtain t1 t2 I' r'
where t1: "t1 ≥ 0" "t1 ≤ t" "(v ⊕ t1) ∈ region X I' r'"
and t2: "t2 ≥ 0" "t2 ≤ t" "(v' ⊕ t2) ∈ region X I' r'"
and valid: "valid_region X k I' r'"
and no_consts: "∀ x ∈ X. ¬ isConst (I' x)"
and C: "?C = {x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ (v ⊕ t1) x + (t - t1)}"
by auto
let ?v = "v ⊕ t1"
let ?t = "t - t1"
let ?C' = "{x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ ?v x + ?t}"
let ?R' = "region X I' r'"
from C ‹?C = {}› have "?C' = {}" by blast
from critical_empty_intro[OF no_consts t1(3) _ this] t1 have "(?v ⊕ ?t) ∈ ?R'" by auto
from region_unique[OF less(2) this] less(2) valid t2 show ?thesis
by (auto simp: cval_add_def)
qed
next
case False
then obtain x c where x: "x ∈ X" "I x = Intv c" "v x + t ≥ c + 1" by auto
then have F: "¬ (∀ x ∈ X. ∃ c. I x = Greater c)" by force
show ?thesis
proof (cases "∃ x ∈ X. isConst (I x)")
case False
then have "∀x∈X. ¬isConst (I x)" by auto
from intro_intv[OF ‹v ∈ ?R› ‹v' ∈ ?R› this x less(3,7,8)] show ?thesis by auto
next
case True
then have "{x ∈ X. ∃c. I x = Const c} ≠ {}" by auto
from const_dest[OF True ‹t > 0›] obtain t1 t2 I' r'
where t1: "t1 ≥ 0" "t1 ≤ t" "(v ⊕ t1) ∈ region X I' r'"
and t2: "t2 ≥ 0" "t2 ≤ t" "(v' ⊕ t2) ∈ region X I' r'"
and valid: "valid_region X k I' r'"
and no_consts: "∀ x ∈ X. ¬ isConst (I' x)"
and C: "?C = {x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ (v ⊕ t1) x + (t - t1)}"
by auto
let ?v = "v ⊕ t1"
let ?t = "t - t1"
let ?C' = "{x ∈ X. ∃c. I' x = Intv c ∧ real (c + 1) ≤ ?v x + ?t}"
let ?R' = "region X I' r'"
show ?thesis
proof (cases "?C' = {}")
case False
with intro_intv[OF t1(3) t2(3) no_consts _ _ _ valid _ _ C] ‹t < 1› t1 obtain t' where
"t' ≥ 0" "((v' ⊕ t2) ⊕ t') ∈ [(v ⊕ t)]⇩ℛ"
by (auto simp: cval_add_def)
moreover have "((v' ⊕ t2) ⊕ t') = (v' ⊕ (t2 + t'))" by (auto simp: cval_add_def)
moreover have "t2 + t' ≥ 0" using ‹t' ≥ 0› ‹t2 ≥ 0› by auto
ultimately show ?thesis by metis
next
case True
from critical_empty_intro[OF no_consts t1(3) _ this] t1 have "((v ⊕ t1) ⊕ ?t) ∈ ?R'" by auto
from region_unique[OF less(2) this] less(2) valid t2 show ?thesis
by (auto simp: cval_add_def)
qed
qed
qed
qed
qed
text ‹
Finally, we can put the two pieces together: for a non-negative shift @{term t}, we first shift
@{term "floor t"} and then @{term "frac t"}.
›
lemma set_of_regions:
fixes X k
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "R ∈ ℛ" "v ∈ R" "R' ∈ Succ ℛ R" "finite X"
shows "∃ t≥0. [v ⊕ t]⇩ℛ = R'" using assms
proof -
from assms(4) obtain v' t where v': "v' ∈ R" "R' ∈ ℛ" "0 ≤ t" "R' = [v' ⊕ t]⇩ℛ" by fastforce
obtain t1 :: int where t1: "t1 = floor t" by auto
with v'(3) have "t1 ≥ 0" by auto
from int_shift_equiv[OF v'(1) ‹v ∈ R› assms(2)[unfolded ℛ_def] this] ℛ_def
have *: "(v ⊕ t1) ∈ [v' ⊕ t1]⇩ℛ" by auto
let ?v = "(v ⊕ t1)"
let ?t2 = "frac t"
have frac: "0 ≤ ?t2" "?t2 < 1" by (auto simp: frac_lt_1)
let ?R = "[v' ⊕ t1]⇩ℛ"
from regions_closed[OF _ assms(2) v'(1)] ‹t1 ≥ 0› ℛ_def have "?R ∈ ℛ" by auto
with assms obtain I r where R: "?R = region X I r" "valid_region X k I r" by auto
with * have v: "?v ∈ region X I r" by auto
from R regions_closed'[OF _ assms(2) v'(1)] ‹t1 ≥ 0› ℛ_def have "(v' ⊕ t1) ∈ region X I r" by auto
from set_of_regions_lt_1[OF R(2) this v assms(5) frac] ℛ_def obtain t2 where
"t2 ≥ 0" "(?v ⊕ t2) ∈ [(v' ⊕ t1) ⊕ ?t2]⇩ℛ"
by auto
moreover from t1 have "(v ⊕ (t1 + t2)) = (?v ⊕ t2)" "v' ⊕ t = ((v' ⊕ t1) ⊕ ?t2)"
by (auto simp: frac_def cval_add_def)
ultimately have "(v ⊕ (t1 + t2)) ∈ [v' ⊕ t]⇩ℛ" "t1 + t2 ≥ 0" using ‹t1 ≥ 0› ‹t2 ≥ 0› by auto
with region_unique[OF _ this(1)] v'(2,4) ℛ_def show ?thesis by blast
qed
section ‹Compability With Clock Constraints›
definition ccval ("⦃_⦄" [100]) where "ccval cc ≡ {v. v ⊢ cc}"
definition ccompatible
where
"ccompatible ℛ cc ≡ ∀ R ∈ ℛ. R ⊆ ccval cc ∨ ccval cc ∩ R = {}"
lemma ccompatible1:
fixes X k fixes c :: real
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "c ≤ k x" "c ∈ ℕ" "x ∈ X"
shows "ccompatible ℛ (EQ x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
case A: (1 I r v u)
from A(3) obtain d where d: "c = of_nat d" unfolding Nats_def by auto
with A(8) have u: "u x = c" "u x = d" unfolding ccval_def by auto
have "I x = Const d"
proof (cases "I x", goal_cases)
case (1 c')
with A(4,9) have "u x = c'" by fastforce
with 1 u show ?case by auto
next
case (2 c')
with A(4,9) have "c' < u x" "u x < c' + 1" by fastforce+
with 2 u show ?case by auto
next
case (3 c')
with A(4,9) have "c' < u x" by fastforce
moreover from 3 A(4,5) have "c' ≥ k x" by fastforce
ultimately show ?case using u A(2) by auto
qed
with A(4,6) d have "v x = c" by fastforce
with A(3,5) have "v ⊢ EQ x c" by auto
with A(7) show False unfolding ccval_def by auto
qed
lemma ccompatible2:
fixes X k fixes c :: real
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "c ≤ k x" "c ∈ ℕ" "x ∈ X"
shows "ccompatible ℛ (LT x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
case A: (1 I r v u)
from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
with A(8) have u: "u x < c" "u x < d" unfolding ccval_def by auto
have "v x < c"
proof (cases "I x", goal_cases)
case (1 c')
with A(4,6,9) have "u x = c'" "v x = c'" by fastforce+
with u show "v x < c" by auto
next
case (2 c')
with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
with u A(3) have "c' + 1 ≤ d" by auto
with d have "c' + 1 ≤ c" by auto
with B u show "v x < c" by auto
next
case (3 c')
with A(4,9) have "c' < u x" by fastforce
moreover from 3 A(4,5) have "c' ≥ k x" by fastforce
ultimately show ?case using u A(2) by auto
qed
with A(4,6) have "v ⊢ LT x c" by auto
with A(7) show False unfolding ccval_def by auto
qed
lemma ccompatible3:
fixes X k fixes c :: real
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "c ≤ k x" "c ∈ ℕ" "x ∈ X"
shows "ccompatible ℛ (LE x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
case A: (1 I r v u)
from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
with A(8) have u: "u x ≤ c" "u x ≤ d" unfolding ccval_def by auto
have "v x ≤ c"
proof (cases "I x", goal_cases)
case (1 c') with A(4,6,9) u show ?case by fastforce
next
case (2 c')
with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
with u A(3) have "c' + 1 ≤ d" by auto
with d u A(3) have "c' + 1 ≤ c" by auto
with B u show "v x ≤ c" by auto
next
case (3 c')
with A(4,9) have "c' < u x" by fastforce
moreover from 3 A(4,5) have "c' ≥ k x" by fastforce
ultimately show ?case using u A(2) by auto
qed
with A(4,6) have "v ⊢ LE x c" by auto
with A(7) show False unfolding ccval_def by auto
qed
lemma ccompatible4:
fixes X k fixes c :: real
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "c ≤ k x" "c ∈ ℕ" "x ∈ X"
shows "ccompatible ℛ (GT x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
case A: (1 I r v u)
from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
with A(8) have u: "u x > c" "u x > d" unfolding ccval_def by auto
have "v x > c"
proof (cases "I x", goal_cases)
case (1 c') with A(4,6,9) u show ?case by fastforce
next
case (2 c')
with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
with d u have "c' ≥ c" by auto
with B u show "v x > c" by auto
next
case (3 c')
with A(4,6) have "c' < v x" by fastforce
moreover from 3 A(4,5) have "c' ≥ k x" by fastforce
ultimately show ?case using A(2) u(1) by auto
qed
with A(4,6) have "v ⊢ GT x c" by auto
with A(7) show False unfolding ccval_def by auto
qed
lemma ccompatible5:
fixes X k fixes c :: real
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "c ≤ k x" "c ∈ ℕ" "x ∈ X"
shows "ccompatible ℛ (GE x c)" using assms unfolding ccompatible_def
proof (auto, goal_cases)
case A: (1 I r v u)
from A(3) obtain d :: nat where d: "c = of_nat d" unfolding Nats_def by blast
with A(8) have u: "u x ≥ c" "u x ≥ d" unfolding ccval_def by auto
have "v x ≥ c"
proof (cases "I x", goal_cases)
case (1 c') with A(4,6,9) u show ?case by fastforce
next
case (2 c')
with A(4,6,9) have B: "c' < u x" "u x < c' + 1" "c' < v x" "v x < c' + 1" by fastforce+
with d u have "c' ≥ c" by auto
with B u show "v x ≥ c" by auto
next
case (3 c')
with A(4,6) have "c' < v x" by fastforce
moreover from 3 A(4,5) have "c' ≥ k x" by fastforce
ultimately show ?case using A(2) u(1) by auto
qed
with A(4,6) have "v ⊢ GE x c" by auto
with A(7) show False unfolding ccval_def by auto
qed
lemma ccompatible:
fixes X k fixes c :: nat
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "∀(x,m) ∈ collect_clock_pairs cc. m ≤ k x ∧ x ∈ X ∧ m ∈ ℕ"
shows "ccompatible ℛ cc" using assms
proof (induction cc)
case (AND cc1 cc2)
then have IH: "ccompatible ℛ cc1" "ccompatible ℛ cc2" by auto
moreover have "⦃AND cc1 cc2⦄ = ⦃cc1⦄ ∩ ⦃cc2⦄" unfolding ccval_def by auto
ultimately show ?case unfolding ccompatible_def by auto
qed (auto intro: ccompatible1 ccompatible2 ccompatible3 ccompatible4 ccompatible5)
section ‹Compability with Resets›
definition region_set
where
"region_set R x c = {v(x := c) | v. v ∈ R}"
lemma region_set_id:
fixes X k
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "R ∈ ℛ" "v ∈ R" "finite X" "0 ≤ c" "c ≤ k x" "x ∈ X"
shows "[v(x := c)]⇩ℛ = region_set R x c" "[v(x := c)]⇩ℛ ∈ ℛ" "v(x := c) ∈ [v(x := c)]⇩ℛ"
proof -
from assms obtain I r where R: "R = region X I r" "valid_region X k I r" "v ∈ region X I r" by auto
let ?I = "λ y. if x = y then Const c else I y"
let ?r = "{(y,z) ∈ r. x ≠ y ∧ x ≠ z}"
let ?X⇩0 = "{x ∈ X. ∃ c. I x = Intv c}"
let ?X⇩0' = "{x ∈ X. ∃ c. ?I x = Intv c}"
from R(2) have refl: "refl_on ?X⇩0 r" and trans: "trans r" and total: "total_on ?X⇩0 r" by auto
have valid: "valid_region X k ?I ?r"
proof
show "?X⇩0 - {x} = ?X⇩0'" by auto
next
from refl show "refl_on (?X⇩0 - {x}) ?r" unfolding refl_on_def by auto
next
from trans show "trans ?r" unfolding trans_def by blast
next
from total show "total_on (?X⇩0 - {x}) ?r" unfolding total_on_def by auto
next
from R(2) have "∀ x ∈ X. valid_intv (k x) (I x)" by auto
with ‹c ≤ k x› show "∀ x ∈ X. valid_intv (k x) (?I x)" by auto
qed
{ fix v assume v: "v ∈ region_set R x c"
with R(1) obtain v' where v': "v' ∈ region X I r" "v = v'(x := c)" unfolding region_set_def by auto
have "v ∈ region X ?I ?r"
proof (standard, goal_cases)
case 1
from v' ‹0 ≤ c› show ?case by auto
next
case 2
from v' show ?case
proof (auto, goal_cases)
case (1 y)
then have "intv_elem y v' (I y)" by auto
with ‹x ≠ y› show "intv_elem y (v'(x := c)) (I y)" by (cases "I y") auto
qed
next
show "?X⇩0 - {x} = ?X⇩0'" by auto
next
from v' show "∀ y ∈ ?X⇩0 - {x}. ∀ z ∈ ?X⇩0 - {x}. (y,z) ∈ ?r ⟷ frac (v y) ≤ frac (v z)" by auto
qed
} moreover
{ fix v assume v: "v ∈ region X ?I ?r"
have "∃ c. v(x := c) ∈ region X I r"
proof (cases "I x")
case (Const c)
from R(2) have "c ≥ 0" by auto
let ?v = "v(x := c)"
have "?v ∈ region X I r"
proof (standard, goal_cases)
case 1
from ‹c≥0› v show ?case by auto
next
case 2
show ?case
proof (auto, goal_cases)
case (1 y)
with v have "intv_elem y v (?I y)" by fast
with Const show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
qed
next
from Const show "?X⇩0' = ?X⇩0" by auto
with refl have "r ⊆ ?X⇩0' × ?X⇩0'" unfolding refl_on_def by auto
then have r: "?r = r" by auto
from v have "∀ y ∈ ?X⇩0'. ∀ z ∈ ?X⇩0'. (y,z) ∈ ?r ⟷ frac (v y) ≤ frac (v z)" by fastforce
with r show "∀ y ∈ ?X⇩0'. ∀ z ∈ ?X⇩0'. (y,z) ∈ r ⟷ frac (?v y) ≤ frac (?v z)"
by auto
qed
then show ?thesis by auto
next
case (Greater c)
from R(2) have "c ≥ 0" by auto
let ?v = "v(x := c + 1)"
have "?v ∈ region X I r"
proof (standard, goal_cases)
case 1
from ‹c≥0› v show ?case by auto
next
case 2
show ?case
proof (standard, goal_cases)
case (1 y)
with v have "intv_elem y v (?I y)" by fast
with Greater show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
qed
next
from Greater show "?X⇩0' = ?X⇩0" by auto
with refl have "r ⊆ ?X⇩0' × ?X⇩0'" unfolding refl_on_def by auto
then have r: "?r = r" by auto
from v have "∀ y ∈ ?X⇩0'. ∀ z ∈ ?X⇩0'. (y,z) ∈ ?r ⟷ frac (v y) ≤ frac (v z)" by fastforce
with r show "∀ y ∈ ?X⇩0'. ∀ z ∈ ?X⇩0'. (y,z) ∈ r ⟷ frac (?v y) ≤ frac (?v z)"
by auto
qed
then show ?thesis by auto
next
case (Intv c)
from R(2) have "c ≥ 0" by auto
let ?L = "{frac (v y) | y. y ∈ ?X⇩0 ∧ x ≠ y ∧ (y,x) ∈ r}"
let ?U = "{frac (v y) | y. y ∈ ?X⇩0 ∧ x ≠ y ∧ (x,y) ∈ r}"
let ?l = "if ?L ≠ {} then c + Max ?L else if ?U ≠ {} then c else c + 0.5"
let ?u = "if ?U ≠ {} then c + Min ?U else if ?L ≠ {} then c + 1 else c + 0.5"
from ‹finite X› have fin: "finite ?L" "finite ?U" by auto
{ fix y assume y: "y ∈ ?X⇩0" "x ≠ y" "(y, x) ∈ r"
then have L: "frac (v y) ∈ ?L" by auto
with Max_in[OF fin(1)] have In: "Max ?L ∈ ?L" by auto
then have "frac (Max ?L) = (Max ?L)" using frac_idempotent by fastforce
from Max_ge[OF fin(1) L] have "frac (v y) ≤ Max ?L" .
also have "… = frac (Max ?L)" using In frac_idempotent[symmetric] by fastforce
also have "… = frac (c + Max ?L)" by (auto simp: frac_nat_add_id)
finally have "frac (v y) ≤ frac ?l" using L by auto
} note L_bound = this
{ fix y assume y: "y ∈ ?X⇩0" "x ≠ y" "(x,y) ∈ r"
then have U: "frac (v y) ∈ ?U" by auto
with Min_in[OF fin(2)] have In: "Min ?U ∈ ?U" by auto
then have "frac (Min ?U) = (Min ?U)" using frac_idempotent by fastforce
have "frac (c + Min ?U) = frac (Min ?U)" by (auto simp: frac_nat_add_id)
also have "… = Min ?U" using In frac_idempotent by fastforce
also from Min_le[OF fin(2) U] have "Min ?U ≤ frac (v y)" .
finally have "frac ?u ≤ frac (v y)" using U by auto
} note U_bound = this
{ assume "?L ≠ {}"
from Max_in[OF fin(1) this] obtain l d where l:
"Max ?L = frac (v l)" "l ∈ X" "x ≠ l" "I l = Intv d"
by auto
with v have "d < v l" "v l < d + 1" by fastforce+
with nat_intv_frac_gt0[OF this] frac_lt_1 l(1) have "0 < Max ?L" "Max ?L < 1" by auto
then have "c < c + Max ?L" "c + Max ?L < c + 1" by simp+
} note L_intv = this
{ assume "?U ≠ {}"
from Min_in[OF fin(2) this] obtain u d where u:
"Min ?U = frac (v u)" "u∈ X" "x ≠ u" "I u = Intv d"
by auto
with v have "d < v u" "v u < d + 1" by fastforce+
with nat_intv_frac_gt0[OF this] frac_lt_1 u(1) have "0 < Min ?U" "Min ?U < 1" by auto
then have "c < c + Min ?U" "c + Min ?U < c + 1" by simp+
} note U_intv = this
have l_bound: "c ≤ ?l"
proof (cases "?L = {}")
case True
note T = this
show ?thesis
proof (cases "?U = {}")
case True
with T show ?thesis by simp
next
case False
with U_intv T show ?thesis by simp
qed
next
case False
with L_intv show ?thesis by simp
qed
have l_bound': "c < ?u"
proof (cases "?L = {}")
case True
note T = this
show ?thesis
proof (cases "?U = {}")
case True
with T show ?thesis by simp
next
case False
with U_intv T show ?thesis by simp
qed
next
case False
with U_intv show ?thesis by simp
qed
have u_bound: "?u ≤ c + 1"
proof (cases "?U = {}")
case True
note T = this
show ?thesis
proof (cases "?L = {}")
case True
with T show ?thesis by simp
next
case False
with L_intv T show ?thesis by simp
qed
next
case False
with U_intv show ?thesis by simp
qed
have u_bound': "?l < c + 1"
proof (cases "?U = {}")
case True
note T = this
show ?thesis
proof (cases "?L = {}")
case True
with T show ?thesis by simp
next
case False
with L_intv T show ?thesis by simp
qed
next
case False
with L_intv show ?thesis by simp
qed
have frac_c: "frac c = 0" "frac (c+1) = 0" by auto
have l_u: "?l ≤ ?u"
proof (cases "?L = {}")
case True
note T = this
show ?thesis
proof (cases "?U = {}")
case True
with T show ?thesis by simp
next
case False
with T show ?thesis using Min_in[OF fin(2) False] by (auto simp: frac_c)
qed
next
case False
with Max_in[OF fin(1) this] have l: "?l = c + Max ?L" "Max ?L ∈ ?L" by auto
note F = False
from l(1) have *: "Max ?L < 1" using False L_intv(2) by linarith
show ?thesis
proof (cases "?U = {}")
case True
with F l * show ?thesis by simp
next
case False
from Min_in[OF fin(2) this] l(2) obtain l u where l_u:
"Max ?L = frac (v l)" "Min ?U = frac (v u)" "l ∈ ?X⇩0" "u ∈ ?X⇩0" "(l,x) ∈ r" "(x,u) ∈ r"
"x ≠ l" "x ≠ u"
by auto
from trans l_u(5-) have "(l,u) ∈ ?r" unfolding trans_def by blast
with l_u(1-4) v have *: "Max ?L ≤ Min ?U" by fastforce
with l_u(1,2) have "frac (Max ?L) ≤ frac (Min ?U)" by (simp add: frac_idempotent)
with frac_nat_add_id l(1) False have "frac ?l ≤ frac ?u" by simp
with l(1) * False show ?thesis by simp
qed
qed
obtain d where d: "d = (?l + ?u) / 2" by blast
with l_u have d2: "?l ≤ d" "d ≤ ?u" by simp+
from d l_bound l_bound' u_bound u_bound' have d3: "c < d" "d < c + 1" "d ≥ 0" by simp+
have "floor ?l = c"
proof (cases "?L = {}")
case False
from L_intv[OF False] have "0 ≤ Max ?L" "Max ?L < 1" by auto
from floor_nat_add_id[OF this] False show ?thesis by simp
next
case True
note T = this
show ?thesis
proof (cases "?U = {}")
case True
with T show ?thesis by (simp)
next
case False
from U_intv[OF False] have "0 ≤ Min ?U" "Min ?U < 1" by auto
from floor_nat_add_id[OF this] T False show ?thesis by simp
qed
qed
have floor_u: "floor ?u = (if ?U = {} ∧ ?L ≠ {} then c + 1 else c)"
proof (cases "?U = {}")
case False
from U_intv[OF False] have "0 ≤ Min ?U" "Min ?U < 1" by auto
from floor_nat_add_id[OF this] False show ?thesis by simp
next
case True
note T = this
show ?thesis
proof (cases "?L = {}")
case True
with T show ?thesis by (simp)
next
case False
from L_intv[OF False] have "0 ≤ Max ?L" "Max ?L < 1" by auto
from floor_nat_add_id[OF this] T False show ?thesis by (auto)
qed
qed
{ assume "?L ≠ {}" "?U ≠ {}"
from Max_in[OF fin(1) ‹?L ≠ {}›] obtain w where w:
"w ∈ ?X⇩0" "x ≠ w" "(w,x) ∈ r" "Max ?L = frac (v w)"
by auto
from Min_in[OF fin(2) ‹?U ≠ {}›] obtain z where z:
"z ∈ ?X⇩0" "x ≠ z" "(x,z) ∈ r" "Min ?U = frac (v z)"
by auto
from w z trans have "(w,z) ∈ r" unfolding trans_def by blast
with v w z have "Max ?L ≤ Min ?U" by fastforce
} note l_le_u = this
{ fix y assume y: "y ∈ ?X⇩0" "x ≠ y"
from total y ‹x ∈ X› Intv have total: "(x,y) ∈ r ∨ (y,x) ∈ r" unfolding total_on_def by auto
have "frac (v y) = frac d ⟷ (y,x) ∈ r ∧ (x,y) ∈ r"
proof safe
assume A: "(y,x) ∈ r" "(x,y) ∈ r"
from L_bound[OF y A(1)] U_bound[OF y A(2)] have *:
"frac (v y) ≤ frac ?l" "frac ?u ≤ frac (v y)"
by auto
from A y have **: "?L ≠ {}" "?U ≠ {}" by auto
with L_intv[OF this(1)] U_intv[OF this(2)] have "frac ?l = Max ?L" "frac ?u = Min ?U"
by (auto simp: frac_nat_add_id frac_eq)
with * ** l_le_u have "frac ?l = frac ?u" "frac (v y) = frac ?l" by auto
with d have "d = ((floor ?l + floor ?u) + (frac (v y) + frac (v y))) / 2"
unfolding frac_def by auto
also have "… = c + frac (v y)" using ‹floor ?l = c› floor_u ‹?U ≠ {}› by auto
finally show "frac (v y) = frac d" using frac_nat_add_id frac_idempotent by metis
next
assume A: "frac (v y) = frac d"
show "(y, x) ∈ r"
proof (rule ccontr)
assume B: "(y,x) ∉ r"
with total have B': "(x,y) ∈ r" by auto
from U_bound[OF y this] have u_y:"frac ?u ≤ frac (v y)" by auto
from y B' have U: "?U ≠ {}" and "frac (v y) ∈ ?U" by auto
then have u: "frac ?u = Min ?U" using Min_in[OF fin(2) ‹?U ≠ {}›]
by (auto simp: frac_nat_add_id frac_idempotent)
show False
proof (cases "?L = {}")
case True
from U_intv[OF U] have "0 < Min ?U" "Min ?U < 1" by auto
then have *: "frac (Min ?U / 2) = Min ?U / 2" unfolding frac_eq by simp
from d U True have "d = ((c + c) + Min ?U) / 2" by auto
also have "… = c + Min ?U / 2" by simp
finally have "frac d = Min ?U / 2" using * by (simp add: frac_nat_add_id)
also have "… < Min ?U" using ‹0 < Min ?U› by auto
finally have "frac d < frac ?u" using u by auto
with u_y A show False by auto
next
case False
then have l: "?l = c + Max ?L" by simp
from Max_in[OF fin(1) ‹?L ≠ {}›]
obtain w where w:
"w ∈ ?X⇩0" "x ≠ w" "(w,x) ∈ r" "Max ?L = frac (v w)"
by auto
with ‹(y,x) ∉ r› trans have **: "(y,w) ∉ r" unfolding trans_def by blast
from Min_in[OF fin(2) ‹?U ≠ {}›] Max_in[OF fin(1) ‹?L ≠ {}›] frac_lt_1
have "0 ≤ Max ?L" "Max ?L < 1" "0 ≤ Min ?U" "Min ?U < 1" by auto
then have "0 ≤ (Max ?L + Min ?U) / 2" "(Max ?L + Min ?U) / 2 < 1" by auto
then have ***: "frac ((Max ?L + Min ?U) / 2) = (Max ?L + Min ?U) / 2" unfolding frac_eq ..
from y w have "y ∈ ?X⇩0'" "w ∈ ?X⇩0'" by auto
with v ** have lt: "frac (v y) > frac (v w)" by fastforce
from d U l have "d = ((c + c) + (Max ?L + Min ?U))/2" by auto
also have "… = c + (Max ?L + Min ?U) / 2" by simp
finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
also have "… = (Max ?L + Min ?U) / 2" using *** by simp
also have "… < (frac (v y) + Min ?U) / 2" using lt w(4) by auto
also have "… ≤ frac (v y)" using Min_le[OF fin(2) ‹frac (v y) ∈ ?U›] by auto
finally show False using A by auto
qed
qed
next
assume A: "frac (v y) = frac d"
show "(x, y) ∈ r"
proof (rule ccontr)
assume B: "(x,y) ∉ r"
with total have B': "(y,x) ∈ r" by auto
from L_bound[OF y this] have l_y:"frac ?l ≥ frac (v y)" by auto
from y B' have L: "?L ≠ {}" and "frac (v y) ∈ ?L" by auto
then have l: "frac ?l = Max ?L" using Max_in[OF fin(1) ‹?L ≠ {}›]
by (auto simp: frac_nat_add_id frac_idempotent)
show False
proof (cases "?U = {}")
case True
from L_intv[OF L] have *: "0 < Max ?L" "Max ?L < 1" by auto
from d L True have "d = ((c + c) + (1 + Max ?L)) / 2" by auto
also have "… = c + (1 + Max ?L) / 2" by simp
finally have "frac d = frac ((1 + Max ?L) / 2)" by (simp add: frac_nat_add_id)
also have "… = (1 + Max ?L) / 2" using * unfolding frac_eq by auto
also have "… > Max ?L" using * by auto
finally have "frac d > frac ?l" using l by auto
with l_y A show False by auto
next
case False
then have u: "?u = c + Min ?U" by simp
from Min_in[OF fin(2) ‹?U ≠ {}›]
obtain w where w:
"w ∈ ?X⇩0" "x ≠ w" "(x,w) ∈ r" "Min ?U = frac (v w)"
by auto
with ‹(x,y) ∉ r› trans have **: "(w,y) ∉ r" unfolding trans_def by blast
from Min_in[OF fin(2) ‹?U ≠ {}›] Max_in[OF fin(1) ‹?L ≠ {}›] frac_lt_1
have "0 ≤ Max ?L" "Max ?L < 1" "0 ≤ Min ?U" "Min ?U < 1" by auto
then have "0 ≤ (Max ?L + Min ?U) / 2" "(Max ?L + Min ?U) / 2 < 1" by auto
then have ***: "frac ((Max ?L + Min ?U) / 2) = (Max ?L + Min ?U) / 2" unfolding frac_eq ..
from y w have "y ∈ ?X⇩0'" "w ∈ ?X⇩0'" by auto
with v ** have lt: "frac (v y) < frac (v w)" by fastforce
from d L u have "d = ((c + c) + (Max ?L + Min ?U))/2" by auto
also have "… = c + (Max ?L + Min ?U) / 2" by simp
finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
also have "… = (Max ?L + Min ?U) / 2" using *** by simp
also have "… > (Max ?L + frac (v y)) / 2" using lt w(4) by auto
finally have "frac d > frac (v y)" using Max_ge[OF fin(1) ‹frac (v y) ∈ ?L›] by auto
then show False using A by auto
qed
qed
qed
} note d_frac_equiv = this
have frac_l: "frac ?l ≤ frac d"
proof (cases "?L = {}")
case True
note T = this
show ?thesis
proof (cases "?U = {}")
case True
with T have "?l = ?u" by auto
with d have "d = ?l" by auto
then show ?thesis by auto
next
case False
with T have "frac ?l = 0" by auto
moreover have "frac d ≥ 0" by auto
ultimately show ?thesis by linarith
qed
next
case False
note F = this
then have l: "?l = c + Max ?L" "frac ?l = Max ?L" using Max_in[OF fin(1) ‹?L ≠ {}›]
by (auto simp: frac_nat_add_id frac_idempotent)
from L_intv[OF F] have *: "0 < Max ?L" "Max ?L < 1" by auto
show ?thesis
proof (cases "?U = {}")
case True
from True F have "?u = c + 1" by auto
with l d have "d = ((c + c) + (Max ?L + 1)) / 2" by auto
also have "… = c + (1 + Max ?L) / 2" by simp
finally have "frac d = frac ((1 + Max ?L) / 2)" by (simp add: frac_nat_add_id)
also have "… = (1 + Max ?L) / 2" using * unfolding frac_eq by auto
also have "… > Max ?L" using * by auto
finally show "frac d ≥ frac ?l" using l by auto
next
case False
then have u: "?u = c + Min ?U" "frac ?u = Min ?U" using Min_in[OF fin(2) False]
by (auto simp: frac_nat_add_id frac_idempotent)
from U_intv[OF False] have **: "0 < Min ?U" "Min ?U < 1" by auto
from l u d have "d = ((c + c) + (Max ?L + Min ?U)) / 2" by auto
also have "… = c + (Max ?L + Min ?U) / 2" by simp
finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
also have "… = (Max ?L + Min ?U) / 2" using * ** unfolding frac_eq by auto
also have "… ≥ Max ?L" using l_le_u[OF F False] by auto
finally show ?thesis using l by auto
qed
qed
have frac_u: "?U ≠ {} ∨ ?L = {} ⟶ frac d ≤ frac ?u"
proof (cases "?U = {}")
case True
note T = this
show ?thesis
proof (cases "?L = {}")
case True
with T have "?l = ?u" by auto
with d have "d = ?u" by auto
then show ?thesis by auto
next
case False
with T show ?thesis by auto
qed
next
case False
note F = this
then have u: "?u = c + Min ?U" "frac ?u = Min ?U" using Min_in[OF fin(2) ‹?U ≠ {}›]
by (auto simp: frac_nat_add_id frac_idempotent)
from U_intv[OF F] have *: "0 < Min ?U" "Min ?U < 1" by auto
show ?thesis
proof (cases "?L = {}")
case True
from True F have "?l = c" by auto
with u d have "d = ((c + c) + Min ?U) / 2" by auto
also have "… = c + Min ?U / 2" by simp
finally have "frac d = frac (Min ?U / 2)" by (simp add: frac_nat_add_id)
also have "… = Min ?U / 2" unfolding frac_eq using * by auto
also have "… ≤ Min ?U" using ‹0 < Min ?U› by auto
finally have "frac d ≤ frac ?u" using u by auto
then show ?thesis by auto
next
case False
then have l: "?l = c + Max ?L" "frac ?l = Max ?L" using Max_in[OF fin(1) False]
by (auto simp: frac_nat_add_id frac_idempotent)
from L_intv[OF False] have **: "0 < Max ?L" "Max ?L < 1" by auto
from l u d have "d = ((c + c) + (Max ?L + Min ?U)) / 2" by auto
also have "… = c + (Max ?L + Min ?U) / 2" by simp
finally have "frac d = frac ((Max ?L + Min ?U) / 2)" by (simp add: frac_nat_add_id)
also have "… = (Max ?L + Min ?U) / 2" using * ** unfolding frac_eq by auto
also have "… ≤ Min ?U" using l_le_u[OF False F] by auto
finally show ?thesis using u by auto
qed
qed
have "∀ y ∈ ?X⇩0 - {x}. (y,x) ∈ r ⟷ frac (v y) ≤ frac d"
proof (safe, goal_cases)
case (1 y k)
with L_bound[of y] frac_l show ?case by auto
next
case (2 y k)
show ?case
proof (rule ccontr, goal_cases)
case 1
with total 2 ‹x ∈ X› Intv have "(x,y) ∈ r" unfolding total_on_def by auto
with 2 U_bound[of y] have "?U ≠ {}" "frac ?u ≤ frac (v y)" by auto
with frac_u have "frac d ≤ frac (v y)" by auto
with 2 d_frac_equiv 1 show False by auto
qed
qed
moreover have "∀ y ∈ ?X⇩0 - {x}. (x,y) ∈ r ⟷ frac d ≤ frac (v y)"
proof (safe, goal_cases)
case (1 y k)
then have "?U ≠ {}" by auto
with 1 U_bound[of y] frac_u show ?case by auto
next
case (2 y k)
show ?case
proof (rule ccontr, goal_cases)
case 1
with total 2 ‹x ∈ X› Intv have "(y,x) ∈ r" unfolding total_on_def by auto
with 2 L_bound[of y] have "frac (v y) ≤ frac ?l" by auto
with frac_l have "frac (v y) ≤ frac d" by auto
with 2 d_frac_equiv 1 show False by auto
qed
qed
ultimately have d:
"c < d" "d < c + 1" "∀ y ∈ ?X⇩0 - {x}. (y,x) ∈ r ⟷ frac (v y) ≤ frac d"
"∀ y ∈ ?X⇩0 - {x}. (x,y) ∈ r ⟷ frac d ≤ frac (v y)"
using d3 by auto
let ?v = "v(x := d)"
have "?v ∈ region X I r"
proof (standard, goal_cases)
case 1
from ‹d≥0› v show ?case by auto
next
case 2
show ?case
proof (safe, goal_cases)
case (1 y)
with v have "intv_elem y v (?I y)" by fast
with Intv d(1,2) show "intv_elem y ?v (I y)" by (cases "x = y", auto) (cases "I y", auto)
qed
next
from ‹x ∈ X› Intv show "?X⇩0' ∪ {x} = ?X⇩0" by auto
with refl have "r ⊆ (?X⇩0' ∪ {x}) × (?X⇩0' ∪ {x})" unfolding refl_on_def by auto
have "∀ x ∈ ?X⇩0'. ∀ y ∈ ?X⇩0'. (x,y) ∈ r ⟷ (x,y) ∈ ?r" by auto
with v have "∀ x ∈ ?X⇩0'. ∀ y ∈ ?X⇩0'. (x,y) ∈ r ⟷ frac (v x) ≤ frac (v y)" by fastforce
then have "∀ x ∈ ?X⇩0'. ∀ y ∈ ?X⇩0'. (x,y) ∈ r ⟷ frac (?v x) ≤ frac (?v y)" by auto
with d(3,4) show "∀ y ∈ ?X⇩0' ∪ {x}. ∀ z ∈ ?X⇩0' ∪ {x}. (y,z) ∈ r ⟷ frac (?v y) ≤ frac (?v z)"
proof (auto, goal_cases)
case 1
from refl ‹x ∈ X› Intv show ?case by (auto simp: refl_on_def)
qed
qed
then show ?thesis by auto
qed
then obtain d where "v(x := d) ∈ R" using R by auto
then have "(v(x := d))(x := c) ∈ region_set R x c" unfolding region_set_def by blast
moreover from v ‹x ∈ X› have "(v(x := d))(x := c) = v" by fastforce
ultimately have "v ∈ region_set R x c" by simp
}
ultimately have "region_set R x c = region X ?I ?r" by blast
with valid ℛ_def have *: "region_set R x c ∈ ℛ" by auto
moreover from assms have **: "v (x := c) ∈ region_set R x c" unfolding region_set_def by auto
ultimately show "[v(x := c)]⇩ℛ = region_set R x c" "[v(x := c)]⇩ℛ ∈ ℛ" "v(x := c) ∈ [v(x := c)]⇩ℛ"
using region_unique[OF _ ** *] ℛ_def by auto
qed
definition region_set'
where
"region_set' R r c = {[r → c]v | v. v ∈ R}"
lemma region_set'_id:
fixes X k and c :: nat
defines "ℛ ≡ {region X I r |I r. valid_region X k I r}"
assumes "R ∈ ℛ" "v ∈ R" "finite X" "0 ≤ c" "∀ x ∈ set r. c ≤ k x" "set r ⊆ X"
shows "[[r → c]v]⇩ℛ = region_set' R r c ∧ [[r → c]v]⇩ℛ ∈ ℛ ∧ [r → c]v ∈ [[r → c]v]⇩ℛ" using assms
proof (induction r)
case Nil
from regions_closed[OF _ Nil(2,3)] regions_closed'[OF _ Nil(2,3)] region_unique[OF _ Nil(3,2)] Nil(1)
have "[v]⇩ℛ = R" "[v ⊕ 0]⇩ℛ ∈ ℛ" "(v ⊕ 0) ∈ [v ⊕ 0]⇩ℛ" by auto
then show ?case unfolding region_set'_def cval_add_def by simp
next
case (Cons x xs)
then have "[[xs→c]v]⇩ℛ = region_set' R xs c" "[[xs→c]v]⇩ℛ ∈ ℛ" "[xs→c]v ∈ [[xs→c]v]⇩ℛ" by force+
note IH = this[unfolded ℛ_def]
let ?v = "([xs→c]v)(x := c)"
from region_set_id[OF IH(2,3) ‹finite X› ‹c ≥ 0›, of x] ℛ_def Cons.prems(5,6)
have "[?v]⇩ℛ = region_set ([[xs→real c]v]⇩ℛ) x c" "[?v]⇩ℛ ∈ ℛ" "?v ∈ [?v]⇩ℛ" by auto
moreover have "region_set' R (x # xs) (real c) = region_set ([[xs→real c]v]⇩ℛ) x c"
unfolding region_set_def region_set'_def
proof (safe, goal_cases)
case (1 y u)
let ?u = "[xs→real c]u"
have "[x # xs→real c]u = ?u(x := real c)" by auto
moreover from IH(1) 1 have "?u ∈ [[xs→real c]v]⇩ℛ" unfolding ℛ_def region_set'_def by auto
ultimately show ?case by auto
next
case (2 y u)
with IH(1)[unfolded region_set'_def ℛ_def[symmetric]] show ?case by auto
qed
moreover have "[x # xs→real c]v = ?v" by simp
ultimately show ?case by presburger
qed
section ‹A Semantics Based on Regions›
subsection ‹Single step›
inductive step_r ::
"('a, 'c, t, 's) ta ⇒ ('c, t) zone set ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_,_ ⊢ ⟨_, _⟩ ↝ ⟨_, _⟩" [61,61,61,61] 61)
where
step_t_r:
"⟦ℛ = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k; R ∈ ℛ; R' ∈ Succ ℛ R;
R ⊆ ⦃inv_of A l⦄; R' ⊆ ⦃inv_of A l⦄⟧ ⟹ A,ℛ ⊢ ⟨l,R⟩ ↝ ⟨l,R'⟩" |
step_a_r:
"⟦ℛ = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k; A ⊢ l ⟶⇗g,a,r⇖ l'; R ∈ ℛ⟧
⟹ A,ℛ ⊢ ⟨l,R⟩ ↝ ⟨l',region_set' (R ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}⟩"
inductive_cases[elim!]: "A,ℛ ⊢ ⟨l, u⟩ ↝ ⟨l', u'⟩"
declare step_r.intros[intro]
lemma region_cover':
assumes "ℛ = {region X I r |I r. valid_region X k I r}" and "∀x∈X. 0 ≤ v x"
shows "v ∈ [v]⇩ℛ" "[v]⇩ℛ ∈ ℛ"
proof -
from region_cover[OF assms(2), of k] assms obtain R where R: "R ∈ ℛ" "v ∈ R" by auto
from regions_closed'[OF assms(1) R, of 0] show "v ∈ [v]⇩ℛ" unfolding cval_add_def by auto
from regions_closed[OF assms(1) R, of 0] show "[v]⇩ℛ ∈ ℛ" unfolding cval_add_def by auto
qed
lemma step_r_complete_aux:
fixes R r A l' g
defines "R' ≡ region_set' (R ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}"
assumes "ℛ = {region X I r |I r. valid_region X k I r}"
and "valid_abstraction A X k"
and "u ∈ R"
and "R ∈ ℛ"
and "A ⊢ l ⟶⇗g,a,r⇖ l'"
and "u ⊢ g"
and "[r→0]u ⊢ inv_of A l'"
shows "R = R ∩ {u. u ⊢ g} ∧ R' = region_set' R r 0 ∧ R' ∈ ℛ"
proof -
note A = assms(2-)
from A(2) have *:
"∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
"collect_clkvt (trans_of A) ⊆ X"
"finite X"
by (fastforce elim: valid_abstraction.cases)+
from A(5) *(2) have r: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from *(1) A(5) have "∀(x, m)∈collect_clock_pairs g. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clkt_def by fastforce
from ccompatible[OF this, folded A(1)] A(3,4,6) have "R ⊆ ⦃g⦄"
unfolding ccompatible_def ccval_def by blast
then have R_id: "R ∩ {u. u ⊢ g} = R" unfolding ccval_def by auto
from region_set'_id[OF A(4)[unfolded A(1)] A(3) *(3) _ _ r, of 0, folded A(1)]
have **:
"[[r→0]u]⇩ℛ = region_set' R r 0" "[[r→0]u]⇩ℛ ∈ ℛ" "[r→0]u ∈ [[r→0]u]⇩ℛ"
by auto
let ?R = "[[r→0]u]⇩ℛ"
from *(1) A(5) have ***:
"∀(x, m) ∈ collect_clock_pairs (inv_of A l'). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding inv_of_def clkp_set_def collect_clki_def by fastforce
from ccompatible[OF this, folded A(1)] **(2-) A(7) have "?R ⊆ ⦃inv_of A l'⦄"
unfolding ccompatible_def ccval_def by blast
then have ***: "?R ∩ {u. u ⊢ inv_of A l'} = ?R" unfolding ccval_def by auto
with **(1,2) R_id show ?thesis by (auto simp: R'_def)
qed
lemma step_r_complete:
"⟦A ⊢ ⟨l, u⟩ → ⟨l',u'⟩; ℛ = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k;
∀ x ∈ X. u x ≥ 0⟧ ⟹ ∃ R'. A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝ ⟨l',R'⟩ ∧ u' ∈ R' ∧ R' ∈ ℛ"
proof (induction rule: step.induct, goal_cases)
case (1 A l u a l' u')
note A = this
then obtain g r where u': "u' = [r→0]u" "A ⊢ l ⟶⇗g,a,r⇖ l'" "u ⊢ g" "u' ⊢ inv_of A l'"
by (cases rule: step_a.cases) auto
let ?R'= "region_set' (([u]⇩ℛ) ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}"
from region_cover'[OF A(2,4)] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from step_r_complete_aux[OF A(2,3) this(2,1) u'(2,3)] u'
have *: "[u]⇩ℛ = ([u]⇩ℛ) ∩ {u. u ⊢ g}" "?R' = region_set' ([u]⇩ℛ) r 0" "?R' ∈ ℛ" by auto
from 1(2,3) have "collect_clkvt (trans_of A) ⊆ X" "finite X" by (auto elim: valid_abstraction.cases)
with u'(2) have r: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from * u'(1) R(2) have "u' ∈ ?R'" unfolding region_set'_def by auto
moreover have "A,ℛ ⊢ ⟨l,([u]⇩ℛ)⟩ ↝ ⟨l',?R'⟩" using R(1) A(2,3) u'(2) by auto
ultimately show ?case using *(3) by meson
next
case (2 A l u d l' u')
hence u': "u' = (u ⊕ d)" "u ⊢ inv_of A l" "u ⊕ d ⊢ inv_of A l" "0 ≤ d" and "l = l'" by auto
from region_cover'[OF 2(2,4)] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from SuccI2[OF 2(2) this(2,1) u'(4), of "[u']⇩ℛ"] u'(1) have u'1:
"[u']⇩ℛ ∈ Succ ℛ ([u]⇩ℛ)" "[u']⇩ℛ ∈ ℛ"
by auto
from regions_closed'[OF 2(2) R(1,2) u'(4)] u'(1) have u'2: "u' ∈ [u']⇩ℛ" by simp
from 2(3) have *:
"∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
"collect_clkvt (trans_of A) ⊆ X"
"finite X"
by (fastforce elim: valid_abstraction.cases)+
from *(1) u'(2) have "∀(x, m)∈collect_clock_pairs (inv_of A l). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
from ccompatible[OF this, folded 2(2)] u'1(2) u'2 u'(1,2,3) R have
"[u']⇩ℛ ⊆ ⦃inv_of A l⦄" "([u]⇩ℛ) ⊆ ⦃inv_of A l⦄"
unfolding ccompatible_def ccval_def by auto
with 2 u'1 R(1) have "A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝ ⟨l,([u']⇩ℛ)⟩" by auto
with u'1(2) u'2 ‹l = l'› show ?case by meson
qed
text ‹
Compare this to lemma ‹step_z_sound›. This version is weaker because for regions we may very well
arrive at a successor for which not every valuation can be reached by the predecessor.
This is the case for e.g. the region with only Greater (k x) bounds.
›
lemma step_r_sound:
"A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l',R'⟩ ⟹ ℛ = {region X I r |I r. valid_region X k I r}
⟹ R' ≠ {} ⟹ (∀ u ∈ R. ∃ u' ∈ R'. A ⊢ ⟨l, u⟩ → ⟨l',u'⟩)"
proof (induction rule: step_r.induct)
case (step_t_r ℛ X k A R R' l)
note A = this[unfolded this(1)]
show ?case
proof
fix u assume u: "u ∈ R"
from set_of_regions[OF A(3) this A(4), folded step_t_r(1)] A(2)
obtain t where t: "t ≥ 0" "[u ⊕ t]⇩ℛ = R'" by (auto elim: valid_abstraction.cases)
with regions_closed'[OF A(1,3) u this(1)] step_t_r(1) have *: "(u ⊕ t) ∈ R'" by auto
with u t(1) A(5,6) have "A ⊢ ⟨l, u⟩ → ⟨l,(u ⊕ t)⟩" unfolding ccval_def by auto
with t * show "∃u'∈R'. A ⊢ ⟨l, u⟩ → ⟨l,u'⟩" by meson
qed
next
case A: (step_a_r ℛ X k A l g a r l' R)
show ?case
proof
fix u assume u: "u ∈ R"
from A(6) obtain v where v: "v ∈ R" "v ⊢ g" "[r→0]v ⊢ inv_of A l'" unfolding region_set'_def by auto
let ?R' = "region_set' (R ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}"
from step_r_complete_aux[OF A(1,2) v(1) A(4,3) v(2-)] have R:
"R = R ∩ {u. u ⊢ g}" "?R' = region_set' R r 0"
by auto
from A have "collect_clkvt (trans_of A) ⊆ X" by (auto elim: valid_abstraction.cases)
with A(3) have r: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from u R have *: "[r→0]u ∈ ?R'" "u ⊢ g" "[r→0]u ⊢ inv_of A l'" unfolding region_set'_def by auto
with A(3) have "A ⊢ ⟨l, u⟩ → ⟨l',[r→0]u⟩" apply (intro step.intros(1)) apply rule by auto
with * show "∃a∈?R'. A ⊢ ⟨l, u⟩ → ⟨l',a⟩" by meson
qed
qed
subsection ‹Multi Step›
inductive
steps_r :: "('a, 'c, t, 's) ta ⇒ ('c, t) zone set ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_,_ ⊢ ⟨_, _⟩ ↝* ⟨_, _⟩" [61,61,61,61,61,61] 61)
where
refl: "A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l, R⟩" |
step: "A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l', R'⟩ ⟹ A,ℛ ⊢ ⟨l', R'⟩ ↝ ⟨l'', R''⟩ ⟹ A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l'', R''⟩"
declare steps_r.intros[intro]
lemma steps_alt:
"A ⊢ ⟨l, u⟩ →* ⟨l',u'⟩ ⟹ A ⊢ ⟨l', u'⟩ → ⟨l'',u''⟩ ⟹ A ⊢ ⟨l, u⟩ →* ⟨l'',u''⟩"
by (induction rule: steps.induct) auto
lemma emptiness_preservance: "A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l',R'⟩ ⟹ R = {} ⟹ R' = {}"
by (induction rule: step_r.cases) (auto simp: region_set'_def)
lemma emptiness_preservance_steps: "A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l',R'⟩ ⟹ R = {} ⟹ R' = {}"
apply (induction rule: steps_r.induct)
apply blast
apply (subst emptiness_preservance)
by blast+
text ‹
Note how it is important to define the multi-step semantics "the right way round".
This also the direction Bouyer implies for her implicit induction.
›
lemma steps_r_sound:
"A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l', R'⟩ ⟹ ℛ = {region X I r |I r. valid_region X k I r}
⟹ R' ≠ {} ⟹ u ∈ R ⟹ ∃ u' ∈ R'. A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩"
proof (induction rule: steps_r.induct)
case refl then show ?case by auto
next
case (step A ℛ l R l' R' l'' R'')
from emptiness_preservance[OF step.hyps(2)] step.prems have "R' ≠ {}" by fastforce
with step obtain u' where u': "u' ∈ R'" "A ⊢ ⟨l, u⟩ →* ⟨l',u'⟩" by auto
with step_r_sound[OF step(2,4,5)] obtain u'' where "u'' ∈ R''" "A ⊢ ⟨l', u'⟩ → ⟨l'',u''⟩" by blast
with u' show ?case by (auto intro: steps_alt)
qed
lemma steps_r_sound':
"A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l', R'⟩ ⟹ ℛ = {region X I r |I r. valid_region X k I r}
⟹ R' ≠ {} ⟹ (∃ u' ∈ R'. ∃ u ∈ R. A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩)"
proof goal_cases
case 1
with emptiness_preservance_steps[OF this(1)] obtain u where "u ∈ R" by auto
with steps_r_sound[OF 1 this] show ?case by auto
qed
lemma single_step_r:
"A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l', R'⟩ ⟹ A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l', R'⟩"
by (metis steps_r.refl steps_r.step)
lemma steps_r_alt:
"A,ℛ ⊢ ⟨l', R'⟩ ↝* ⟨l'', R''⟩ ⟹ A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l', R'⟩ ⟹ A,ℛ ⊢ ⟨l, R⟩ ↝* ⟨l'', R''⟩"
apply (induction rule: steps_r.induct)
apply (rule single_step_r)
by auto
lemma single_step:
"x1 ⊢ ⟨x2, x3⟩ → ⟨x4,x5⟩ ⟹ x1 ⊢ ⟨x2, x3⟩ →* ⟨x4,x5⟩"
by (metis steps.intros)
lemma steps_r_complete:
"⟦A ⊢ ⟨l, u⟩ →* ⟨l',u'⟩; ℛ = {region X I r |I r. valid_region X k I r}; valid_abstraction A X k;
∀ x ∈ X. u x ≥ 0⟧ ⟹ ∃ R'. A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝* ⟨l',R'⟩ ∧ u' ∈ R'"
proof (induction rule: steps.induct)
case (refl A l u)
from region_cover'[OF refl(1,3)] show ?case by auto
next
case (step A l u l' u' l'' u'')
from step_r_complete[OF step(1,4-6)] obtain R' where R':
"A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝ ⟨l',R'⟩" "u' ∈ R'" "R' ∈ ℛ"
by auto
with step(4) ‹u' ∈ R'› have "∀x∈X. 0 ≤ u' x" by auto
with step obtain R'' where R'': "A,ℛ ⊢ ⟨l', ([u']⇩ℛ)⟩ ↝* ⟨l'',R''⟩" "u'' ∈ R''" by auto
with region_unique[OF step(4) R'(2,3)] R'(1) have "A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝* ⟨l'',R''⟩"
by (subst steps_r_alt) auto
with R'' region_cover'[OF step(4,6)] show ?case by auto
qed
end
Theory Closure
theory Closure
imports Regions
begin
section ‹Correct Approximation of Zones with ‹α›-regions›
locale AlphaClosure =
fixes X k ℛ and V :: "('c, t) cval set"
defines "ℛ ≡ {region X I r | I r. valid_region X k I r}"
defines "V ≡ {v . ∀ x ∈ X. v x ≥ 0}"
assumes finite: "finite X"
begin
lemmas set_of_regions_spec = set_of_regions[OF _ _ _ finite, of _ k, folded ℛ_def]
lemmas region_cover_spec = region_cover[of X _ k, folded ℛ_def]
lemmas region_unique_spec = region_unique[of ℛ X k, folded ℛ_def, simplified]
lemmas regions_closed'_spec = regions_closed'[of ℛ X k, folded ℛ_def, simplified]
lemma valid_regions_distinct_spec:
"R ∈ ℛ ⟹ R' ∈ ℛ ⟹ v ∈ R ⟹ v ∈ R' ⟹ R = R'"
unfolding ℛ_def using valid_regions_distinct
by auto (drule valid_regions_distinct, assumption+, simp)+
definition cla ("Closure⇩α _" [71] 71)
where
"cla Z = ⋃ {R ∈ ℛ. R ∩ Z ≠ {}}"
subsubsection ‹The nice and easy properties proved by Bouyer›
lemma closure_constraint_id:
"∀(x, m)∈collect_clock_pairs g. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ ⟹ Closure⇩α ⦃g⦄ = ⦃g⦄ ∩ V"
proof goal_cases
case 1
show ?case
proof auto
fix v assume v: "v ∈ Closure⇩α ⦃g⦄"
then obtain R where R: "v ∈ R" "R ∈ ℛ" "R ∩ ⦃g⦄ ≠ {}" unfolding cla_def by auto
with ccompatible[OF 1, folded ℛ_def] show "v ∈ ⦃g⦄" unfolding ccompatible_def by auto
from R show "v ∈ V" unfolding V_def ℛ_def by auto
next
fix v assume v: "v ∈ ⦃g⦄" "v ∈ V"
with region_cover[of X v k, folded ℛ_def] obtain R where "R ∈ ℛ" "v ∈ R" unfolding V_def by auto
then show "v ∈ Closure⇩α ⦃g⦄" unfolding cla_def using v by auto
qed
qed
lemma closure_id':
"Z ≠ {} ⟹ Z ⊆ R ⟹ R ∈ ℛ ⟹ Closure⇩α Z = R"
proof goal_cases
case 1
note A = this
then have "R ⊆ Closure⇩α Z" unfolding cla_def by auto
moreover
{ fix R' assume R': "Z ∩ R' ≠ {}" "R' ∈ ℛ" "R ≠ R'"
with A obtain v where "v ∈ R" "v ∈ R'" by auto
with ℛ_regions_distinct[OF _ A(3) this(1) R'(2-)] ℛ_def have False by auto
}
ultimately show ?thesis unfolding cla_def by auto
qed
lemma closure_id:
"Closure⇩α Z ≠ {} ⟹ Z ⊆ R ⟹ R ∈ ℛ ⟹ Closure⇩α Z = R"
proof goal_cases
case 1
then have "Z ≠ {}" unfolding cla_def by auto
with 1 closure_id' show ?case by blast
qed
lemma closure_update_mono:
"Z ⊆ V ⟹ set r ⊆ X ⟹ zone_set (Closure⇩α Z) r ⊆ Closure⇩α(zone_set Z r)"
proof -
assume A: "Z ⊆ V" "set r ⊆ X"
let ?U = "{R ∈ ℛ. Z ∩ R ≠ {}}"
from A(1) region_cover_spec have "∀ v ∈ Z. ∃ R. R ∈ ℛ ∧ v ∈ R" unfolding V_def by auto
then have "Z = ⋃ {Z ∩ R | R. R ∈ ?U}"
proof (auto, goal_cases)
case (1 v)
then obtain R where "R ∈ ℛ" "v ∈ R" by auto
moreover with 1 have "Z ∩ R ≠ {}" "v ∈ Z ∩ R" by auto
ultimately show ?case by auto
qed
then obtain U where U: "Z = ⋃ {Z ∩ R | R. R ∈ U}" "∀ R ∈ U. R ∈ ℛ" by blast
{ fix R assume R: "R ∈ U"
{ fix v' assume v': "v' ∈ zone_set (Closure⇩α (Z ∩ R)) r - Closure⇩α(zone_set (Z ∩ R) r)"
then obtain v where *:
"v ∈ Closure⇩α (Z ∩ R)" "v' = [r → 0]v"
unfolding zone_set_def by auto
with closure_id[of "Z ∩ R" R] R U(2) have **:
"Closure⇩α (Z ∩ R) = R" "Closure⇩α (Z ∩ R) ∈ ℛ"
by fastforce+
with region_set'_id[OF _ *(1) finite _ _ A(2), of k 0, folded ℛ_def, OF this(2)]
have ***: "zone_set R r ∈ ℛ" "[r→0]v ∈ zone_set R r"
unfolding zone_set_def region_set'_def by auto
from * have "Z ∩ R ≠ {}" unfolding cla_def by auto
then have "zone_set (Z ∩ R) r ≠ {}" unfolding zone_set_def by auto
from closure_id'[OF this _ ***(1)] have "Closure⇩α zone_set (Z ∩ R) r = zone_set R r"
unfolding zone_set_def by auto
with v' **(1) have False by auto
}
then have "zone_set (Closure⇩α (Z ∩ R)) r ⊆ Closure⇩α(zone_set (Z ∩ R) r)" by auto
} note Z_i = this
from U(1) have "Closure⇩α Z = ⋃ {Closure⇩α (Z ∩ R) | R. R ∈ U}" unfolding cla_def by auto
then have "zone_set (Closure⇩α Z) r = ⋃ {zone_set (Closure⇩α (Z ∩ R)) r | R. R ∈ U}"
unfolding zone_set_def by auto
also have "… ⊆ ⋃ {Closure⇩α(zone_set (Z ∩ R) r) | R. R ∈ U}" using Z_i by auto
also have "… = Closure⇩α ⋃ {(zone_set (Z ∩ R) r) | R. R ∈ U}" unfolding cla_def by auto
also have "… = Closure⇩α zone_set (⋃ {Z ∩ R| R. R ∈ U}) r"
proof goal_cases
case 1
have "zone_set (⋃ {Z ∩ R| R. R ∈ U}) r = ⋃ {(zone_set (Z ∩ R) r) | R. R ∈ U}"
unfolding zone_set_def by auto
then show ?case by auto
qed
finally show "zone_set (Closure⇩α Z) r ⊆ Closure⇩α(zone_set Z r)" using U by simp
qed
lemma SuccI3:
"R ∈ ℛ ⟹ v ∈ R ⟹ t ≥ 0 ⟹ (v ⊕ t) ∈ R' ⟹ R' ∈ ℛ ⟹ R' ∈ Succ ℛ R"
apply (intro SuccI2[of ℛ X k, folded ℛ_def, simplified])
apply assumption+
apply (intro region_unique[of ℛ X k, folded ℛ_def, simplified, symmetric])
by assumption+
lemma closure_delay_mono:
"Z ⊆ V ⟹ (Closure⇩α Z)⇧↑ ⊆ Closure⇩α (Z⇧↑)"
proof
fix v assume v: "v ∈ (Closure⇩α Z)⇧↑" and Z: "Z ⊆ V"
then obtain u u' t R where A:
"u ∈ Closure⇩α Z" "v = (u ⊕ t)" "u ∈ R" "u' ∈ R" "R ∈ ℛ" "u' ∈ Z" "t ≥ 0"
unfolding cla_def zone_delay_def by blast
from A(3,5) have "∀ x ∈ X. u x ≥ 0" unfolding ℛ_def by fastforce
with region_cover_spec[of v] A(2,7) obtain R' where R':
"R' ∈ ℛ" "v ∈ R'"
unfolding cval_add_def by auto
with set_of_regions_spec[OF A(5,4), OF SuccI3, of u] A obtain t where t:
"t ≥ 0" "[u' ⊕ t]⇩ℛ = R'"
by auto
with A have "(u' ⊕ t) ∈ Z⇧↑" unfolding zone_delay_def by auto
moreover from regions_closed'_spec[OF A(5,4)] t have "(u' ⊕ t) ∈ R'" by auto
ultimately have "R' ∩ (Z⇧↑) ≠ {}" by auto
with R' show "v ∈ Closure⇩α (Z⇧↑)" unfolding cla_def by auto
qed
lemma region_V: "R ∈ ℛ ⟹ R ⊆ V" using V_def ℛ_def region.cases by auto
lemma closure_V:
"Closure⇩α Z ⊆ V"
unfolding cla_def using region_V by auto
lemma closure_V_int:
"Closure⇩α Z = Closure⇩α (Z ∩ V)"
unfolding cla_def using region_V by auto
lemma closure_constraint_mono:
"Closure⇩α g = g ⟹ g ∩ (Closure⇩α Z) ⊆ Closure⇩α (g ∩ Z)"
unfolding cla_def by auto
lemma closure_constraint_mono':
assumes "Closure⇩α g = g ∩ V"
shows "g ∩ (Closure⇩α Z) ⊆ Closure⇩α (g ∩ Z)"
proof -
from assms closure_V_int have "Closure⇩α (g ∩ V) = g ∩ V" by auto
from closure_constraint_mono[OF this, of Z] have
"g ∩ (V ∩ Closure⇩α Z) ⊆ Closure⇩α (g ∩ Z ∩ V)"
by (metis Int_assoc Int_commute)
with closure_V[of Z] closure_V_int[of "g ∩ Z"] show ?thesis by auto
qed
lemma cla_empty_iff:
"Z ⊆ V ⟹ Z = {} ⟷ Closure⇩α Z = {}"
unfolding cla_def V_def using region_cover_spec by fast
lemma closure_involutive_aux:
"U ⊆ ℛ ⟹ Closure⇩α ⋃ U = ⋃ U"
unfolding cla_def using valid_regions_distinct_spec by blast
lemma closure_involutive_aux':
"∃ U. U ⊆ ℛ ∧ Closure⇩α Z = ⋃ U"
unfolding cla_def by (rule exI[where x = "{R ∈ ℛ. R ∩ Z ≠ {}}"]) auto
lemma closure_involutive:
"Closure⇩α Closure⇩α Z = Closure⇩α Z"
using closure_involutive_aux closure_involutive_aux' by metis
lemma closure_involutive':
"Z ⊆ Closure⇩α W ⟹ Closure⇩α Z ⊆ Closure⇩α W"
unfolding cla_def using valid_regions_distinct_spec by fast
lemma closure_subs:
"Z ⊆ V ⟹ Z ⊆ Closure⇩α Z"
unfolding cla_def V_def using region_cover_spec by fast
lemma cla_mono':
"Z' ⊆ V ⟹ Z ⊆ Z' ⟹ Closure⇩α Z ⊆ Closure⇩α Z'"
by (meson closure_involutive' closure_subs subset_trans)
lemma cla_mono:
"Z ⊆ Z' ⟹ Closure⇩α Z ⊆ Closure⇩α Z'"
using closure_V_int cla_mono'[of "Z' ∩ V" "Z ∩ V"] by auto
section ‹A New Zone Semantics Abstracting with ‹Closure⇩α››
subsection ‹Single step›
inductive step_z_alpha ::
"('a, 'c, t, 's) ta ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇩α ⟨_, _⟩" [61,61,61] 61)
where
step_alpha: "A ⊢ ⟨l, Z⟩ ↝ ⟨l', Z'⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l', Closure⇩α Z'⟩"
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ ↝⇩α ⟨l',u'⟩"
declare step_z_alpha.intros[intro]
lemma up_V: "Z ⊆ V ⟹ Z⇧↑ ⊆ V"
unfolding V_def zone_delay_def cval_add_def by auto
lemma reset_V: "Z ⊆ V ⟹ (zone_set Z r) ⊆ V"
unfolding V_def unfolding zone_set_def by (induction r, auto)
lemma step_z_V: "A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ Z ⊆ V ⟹ Z' ⊆ V"
apply (induction rule: step_z.induct)
apply (rule le_infI1)
apply (rule up_V)
apply blast
apply (rule le_infI1)
apply (rule reset_V)
by blast
text ‹Single-step soundness and completeness follows trivially from ‹cla_empty_iff›.›
lemma step_z_alpha_sound:
"A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l',Z'⟩ ⟹ Z ⊆ V ⟹ Z' ≠ {} ⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z''⟩ ∧ Z'' ≠ {}"
apply (induction rule: step_z_alpha.induct)
apply (frule step_z_V)
apply assumption
apply (rotate_tac 3)
apply (drule cla_empty_iff)
by auto
lemma step_z_alpha_complete:
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ Z ⊆ V ⟹ Z' ≠ {} ⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l',Z''⟩ ∧ Z'' ≠ {}"
apply (frule step_z_V)
apply assumption
apply (rotate_tac 3)
apply (drule cla_empty_iff)
by auto
lemma zone_set_mono:
"A ⊆ B ⟹ zone_set A r ⊆ zone_set B r"
unfolding zone_set_def by auto
lemma zone_delay_mono:
"A ⊆ B ⟹ A⇧↑ ⊆ B⇧↑"
unfolding zone_delay_def by auto
subsection ‹Multi step›
inductive
steps_z_alpha :: "('a, 'c, t, 's) ta ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇩α* ⟨_, _⟩" [61,61,61] 61)
where
refl: "A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l, Z⟩" |
step: "A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝⇩α ⟨l'', Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l'', Z''⟩"
declare steps_z_alpha.intros[intro]
lemma subset_int_mono: "A ⊆ B ⟹ A ∩ C ⊆ B ∩ C" by blast
text ‹P. Bouyer's calculation for @{term "Post(Closure⇩α Z, e) ⊆ Closure⇩α(Post (Z, e))"}›
text ‹This is now obsolete as we argue solely with monotonicty of ‹steps_z› w.r.t ‹Closure⇩α››
lemma calc:
"valid_abstraction A X k ⟹ Z ⊆ V ⟹ A ⊢ ⟨l, Closure⇩α Z⟩ ↝ ⟨l', Z'⟩
⟹ ∃Z''. A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l', Z''⟩ ∧ Z' ⊆ Z''"
proof (cases rule: step_z.cases, assumption, goal_cases)
case 1
note A = this
from A(1) have "∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
by (fastforce elim: valid_abstraction.cases)
then have "∀(x, m)∈collect_clock_pairs (inv_of A l). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clki_def inv_of_def by auto
from closure_constraint_id[OF this] have *: "Closure⇩α ⦃inv_of A l⦄ = ⦃inv_of A l⦄ ∩ V" .
from closure_constraint_mono'[OF *, of Z] have
"(Closure⇩α Z) ∩ {u. u ⊢ inv_of A l} ⊆ Closure⇩α (Z ∩ {u. u ⊢ inv_of A l})"
unfolding ccval_def by (subst Int_commute) (subst (asm) (2) Int_commute, assumption)
moreover have "…⇧↑ ⊆ Closure⇩α ((Z ∩ {u. u ⊢ inv_of A l})⇧↑)" using A(2) by (blast intro!: closure_delay_mono)
ultimately have "Z' ⊆ Closure⇩α ((Z ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l})"
using closure_constraint_mono'[OF *, of "(Z ∩ {u. u ⊢ inv_of A l})⇧↑"] unfolding ccval_def
apply (subst A(5))
apply (subst (asm) (5 7) Int_commute)
apply (rule subset_trans)
defer
apply assumption
apply (subst subset_int_mono)
defer
apply rule
apply (rule subset_trans)
defer
apply assumption
apply (rule zone_delay_mono)
apply assumption
done
with A(4,3) show ?thesis by auto
next
case (2 g a r)
note A = this
from A(1) have *:
"∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
"collect_clkvt (trans_of A) ⊆ X"
"finite X"
by (auto elim: valid_abstraction.cases)
from *(1) A(5) have "∀(x, m)∈collect_clock_pairs (inv_of A l'). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
from closure_constraint_id[OF this] have **: "Closure⇩α ⦃inv_of A l'⦄ = ⦃inv_of A l'⦄ ∩ V" .
from *(1) A(5) have "∀(x, m)∈collect_clock_pairs g. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clkt_def by fastforce
from closure_constraint_id[OF this] have ***: "Closure⇩α ⦃g⦄ = ⦃g⦄ ∩ V" .
from *(2) A(5) have ****: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from closure_constraint_mono'[OF ***, of Z] have
"(Closure⇩α Z) ∩ {u. u ⊢ g} ⊆ Closure⇩α (Z ∩ {u. u ⊢ g})" unfolding ccval_def
by (subst Int_commute) (subst (asm) (2) Int_commute, assumption)
moreover have "zone_set … r ⊆ Closure⇩α (zone_set (Z ∩ {u. u ⊢ g}) r)" using **** A(2)
by (intro closure_update_mono, auto)
ultimately have "Z' ⊆ Closure⇩α (zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'})"
using closure_constraint_mono'[OF **, of "zone_set (Z ∩ {u. u ⊢ g}) r"] unfolding ccval_def
apply (subst A(4))
apply (subst (asm) (5 7) Int_commute)
apply (rule subset_trans)
defer
apply assumption
apply (subst subset_int_mono)
defer
apply rule
apply (rule subset_trans)
defer
apply assumption
apply (rule zone_set_mono)
apply assumption
done
with A(5) show ?thesis by auto
qed
text ‹
Turning P. Bouyers argument for multiple steps into an inductive proof is not direct.
With this initial argument we can get to a point where the induction hypothesis is applicable.
This breaks the "information hiding" induced by the different variants of steps.
›
lemma steps_z_alpha_closure_involutive'_aux:
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ Closure⇩α Z ⊆ Closure⇩α W ⟹ valid_abstraction A X k ⟹ Z ⊆ V
⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩ ∧ Closure⇩α Z' ⊆ Closure⇩α W'"
proof (induction rule: step_z.induct)
case A: (step_t_z A l Z)
let ?Z' = "(Z ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
let ?W' = "(W ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
from ℛ_def have ℛ_def': "ℛ = {region X I r |I r. valid_region X k I r}" by simp
have step_z: "A ⊢ ⟨l, W⟩ ↝ ⟨l,?W'⟩" by auto
moreover have "Closure⇩α ?Z' ⊆ Closure⇩α ?W'"
proof
fix v assume v: "v ∈ Closure⇩α ?Z'"
then obtain R' v' where 1: "R' ∈ ℛ" "v ∈ R'" "v' ∈ R'" "v' ∈ ?Z'" unfolding cla_def by auto
then obtain u d where
"u ∈ Z" and v': "v' = u ⊕ d" "u ⊢ inv_of A l" "u ⊕ d ⊢ inv_of A l" "0 ≤ d"
unfolding zone_delay_def by blast
with closure_subs[OF A(3)] A(1) obtain u' R where u': "u' ∈ W" "u ∈ R" "u' ∈ R" "R ∈ ℛ"
unfolding cla_def by blast
then have "∀x∈X. 0 ≤ u x" unfolding ℛ_def by fastforce
from region_cover'[OF ℛ_def' this] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from SuccI2[OF ℛ_def' this(2,1) v'(4), of "[v']⇩ℛ"] v'(1) have v'1:
"[v']⇩ℛ ∈ Succ ℛ ([u]⇩ℛ)" "[v']⇩ℛ ∈ ℛ"
by auto
from regions_closed'_spec[OF R(1,2) v'(4)] v'(1) have v'2: "v' ∈ [v']⇩ℛ" by simp
from A(2) have *:
"∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
"collect_clkvt (trans_of A) ⊆ X"
"finite X"
by (auto elim: valid_abstraction.cases)
from *(1) u'(2) have "∀(x, m)∈collect_clock_pairs (inv_of A l). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
from ccompatible[OF this, folded ℛ_def'] v'1(2) v'2 v'(1,2,3) R have 3:
"[v']⇩ℛ ⊆ ⦃inv_of A l⦄" "([u]⇩ℛ) ⊆ ⦃inv_of A l⦄"
unfolding ccompatible_def ccval_def by auto
with A v'1 R(1) ℛ_def' have "A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝ ⟨l,([v']⇩ℛ)⟩" by auto
with valid_regions_distinct_spec[OF v'1(2) 1(1) v'2 1(3)] region_unique_spec[OF u'(2,4)]
have step_r: "A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l, R'⟩" and 2: "[v']⇩ℛ = R'" "[u]⇩ℛ = R" by auto
from set_of_regions_spec[OF u'(4,3)] v'1(1) 2 obtain t where t: "t ≥ 0" "[u' ⊕ t]⇩ℛ = R'" by auto
with regions_closed'_spec[OF u'(4,3) this(1)] step_t_r(1) have *: "u' ⊕ t ∈ R'" by auto
with t(1) 3 2 u'(1,3) have "A ⊢ ⟨l, u'⟩ → ⟨l, u' ⊕ t⟩" "u' ⊕ t ∈ ?W'"
unfolding zone_delay_def ccval_def by auto
with * 1(1) have "R' ⊆ Closure⇩α ?W'" unfolding cla_def by auto
with 1(2) show "v ∈ Closure⇩α ?W'" ..
qed
ultimately show ?case by auto
next
case A: (step_a_z A l g a r l' Z)
let ?Z' = "zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
let ?W' = "zone_set (W ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
from ℛ_def have ℛ_def': "ℛ = {region X I r |I r. valid_region X k I r}" by simp
from A(1) have step_z: "A ⊢ ⟨l, W⟩ ↝ ⟨l',?W'⟩" by auto
moreover have "Closure⇩α ?Z' ⊆ Closure⇩α ?W'"
proof
fix v assume v: "v ∈ Closure⇩α ?Z'"
then obtain R' v' where 1: "R' ∈ ℛ" "v ∈ R'" "v' ∈ R'" "v' ∈ ?Z'" unfolding cla_def by auto
then obtain u where
"u ∈ Z" and v': "v' = [r→0]u" "u ⊢ g" "v' ⊢ inv_of A l'"
unfolding zone_set_def by blast
let ?R'= "region_set' (([u]⇩ℛ) ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}"
from ‹u ∈ Z› closure_subs[OF A(4)] A(2) obtain u' R where u': "u' ∈ W" "u ∈ R" "u' ∈ R" "R ∈ ℛ"
unfolding cla_def by blast
then have "∀x∈X. 0 ≤ u x" unfolding ℛ_def by fastforce
from region_cover'[OF ℛ_def' this] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from step_r_complete_aux[OF ℛ_def' A(3) this(2,1) A(1) v'(2)] v'
have *: "[u]⇩ℛ = ([u]⇩ℛ) ∩ {u. u ⊢ g}" "?R' = region_set' ([u]⇩ℛ) r 0" "?R' ∈ ℛ" by auto
from ℛ_def' A(3) have "collect_clkvt (trans_of A) ⊆ X" "finite X"
by (auto elim: valid_abstraction.cases)
with A(1) have r: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from * v'(1) R(2) have "v' ∈ ?R'" unfolding region_set'_def by auto
moreover have "A,ℛ ⊢ ⟨l,([u]⇩ℛ)⟩ ↝ ⟨l',?R'⟩" using R(1) ℛ_def' A(1,3) v'(2) by auto
thm valid_regions_distinct_spec
with valid_regions_distinct_spec[OF *(3) 1(1) ‹v' ∈ ?R'› 1(3)] region_unique_spec[OF u'(2,4)]
have 2: "?R' = R'" "[u]⇩ℛ = R" by auto
with * u' have *: "[r→0]u' ∈ ?R'" "u' ⊢ g" "[r→0]u' ⊢ inv_of A l'"
unfolding region_set'_def by auto
with A(1) have "A ⊢ ⟨l, u'⟩ → ⟨l',[r→0]u'⟩" apply (intro step.intros(1)) apply rule by auto
moreover from * u'(1) have "[r→0]u' ∈ ?W'" unfolding zone_set_def by auto
ultimately have "R' ⊆ Closure⇩α ?W'" using *(1) 1(1) 2(1) unfolding cla_def by auto
with 1(2) show "v ∈ Closure⇩α ?W'" ..
qed
ultimately show ?case by meson
qed
lemma steps_z_alpha_closure_involutive'_aux':
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ Closure⇩α Z ⊆ Closure⇩α W ⟹ valid_abstraction A X k ⟹ Z ⊆ V ⟹ W ⊆ Z
⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩ ∧ Closure⇩α Z' ⊆ Closure⇩α W' ∧ W' ⊆ Z'"
proof (induction rule: step_z.induct)
case A: (step_t_z A l Z)
let ?Z' = "(Z ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
let ?W' = "(W ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
from ℛ_def have ℛ_def': "ℛ = {region X I r |I r. valid_region X k I r}" by simp
have step_z: "A ⊢ ⟨l, W⟩ ↝ ⟨l,?W'⟩" by auto
moreover have "Closure⇩α ?Z' ⊆ Closure⇩α ?W'"
proof
fix v assume v: "v ∈ Closure⇩α ?Z'"
then obtain R' v' where 1: "R' ∈ ℛ" "v ∈ R'" "v' ∈ R'" "v' ∈ ?Z'" unfolding cla_def by auto
then obtain u d where
"u ∈ Z" and v': "v' = u ⊕ d" "u ⊢ inv_of A l" "u ⊕ d ⊢ inv_of A l" "0 ≤ d"
unfolding zone_delay_def by blast
with closure_subs[OF A(3)] A(1) obtain u' R where u': "u' ∈ W" "u ∈ R" "u' ∈ R" "R ∈ ℛ"
unfolding cla_def by blast
then have "∀x∈X. 0 ≤ u x" unfolding ℛ_def by fastforce
from region_cover'[OF ℛ_def' this] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from SuccI2[OF ℛ_def' this(2,1) v'(4), of "[v']⇩ℛ"] v'(1) have v'1:
"[v']⇩ℛ ∈ Succ ℛ ([u]⇩ℛ)" "[v']⇩ℛ ∈ ℛ"
by auto
from regions_closed'_spec[OF R(1,2) v'(4)] v'(1) have v'2: "v' ∈ [v']⇩ℛ" by simp
from A(2) have *:
"∀(x, m)∈clkp_set A. m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
"collect_clkvt (trans_of A) ⊆ X"
"finite X"
by (auto elim: valid_abstraction.cases)
from *(1) u'(2) have "∀(x, m)∈collect_clock_pairs (inv_of A l). m ≤ real (k x) ∧ x ∈ X ∧ m ∈ ℕ"
unfolding clkp_set_def collect_clki_def inv_of_def by fastforce
from ccompatible[OF this, folded ℛ_def'] v'1(2) v'2 v'(1,2,3) R have 3:
"[v']⇩ℛ ⊆ ⦃inv_of A l⦄" "([u]⇩ℛ) ⊆ ⦃inv_of A l⦄"
unfolding ccompatible_def ccval_def by auto
with A v'1 R(1) ℛ_def' have "A,ℛ ⊢ ⟨l, ([u]⇩ℛ)⟩ ↝ ⟨l,([v']⇩ℛ)⟩" by auto
with valid_regions_distinct_spec[OF v'1(2) 1(1) v'2 1(3)] region_unique_spec[OF u'(2,4)]
have step_r: "A,ℛ ⊢ ⟨l, R⟩ ↝ ⟨l, R'⟩" and 2: "[v']⇩ℛ = R'" "[u]⇩ℛ = R" by auto
from set_of_regions_spec[OF u'(4,3)] v'1(1) 2 obtain t where t: "t ≥ 0" "[u' ⊕ t]⇩ℛ = R'" by auto
with regions_closed'_spec[OF u'(4,3) this(1)] step_t_r(1) have *: "u' ⊕ t ∈ R'" by auto
with t(1) 3 2 u'(1,3) have "A ⊢ ⟨l, u'⟩ → ⟨l, u' ⊕ t⟩" "u' ⊕ t ∈ ?W'"
unfolding zone_delay_def ccval_def by auto
with * 1(1) have "R' ⊆ Closure⇩α ?W'" unfolding cla_def by auto
with 1(2) show "v ∈ Closure⇩α ?W'" ..
qed
moreover have "?W' ⊆ ?Z'" using ‹W ⊆ Z› unfolding zone_delay_def by auto
ultimately show ?case by auto
next
case A: (step_a_z A l g a r l' Z)
let ?Z' = "zone_set (Z ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
let ?W' = "zone_set (W ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
from ℛ_def have ℛ_def': "ℛ = {region X I r |I r. valid_region X k I r}" by simp
from A(1) have step_z: "A ⊢ ⟨l, W⟩ ↝ ⟨l',?W'⟩" by auto
moreover have "Closure⇩α ?Z' ⊆ Closure⇩α ?W'"
proof
fix v assume v: "v ∈ Closure⇩α ?Z'"
then obtain R' v' where 1: "R' ∈ ℛ" "v ∈ R'" "v' ∈ R'" "v' ∈ ?Z'" unfolding cla_def by auto
then obtain u where
"u ∈ Z" and v': "v' = [r→0]u" "u ⊢ g" "v' ⊢ inv_of A l'"
unfolding zone_set_def by blast
let ?R'= "region_set' (([u]⇩ℛ) ∩ {u. u ⊢ g}) r 0 ∩ {u. u ⊢ inv_of A l'}"
from ‹u ∈ Z› closure_subs[OF A(4)] A(2) obtain u' R where u': "u' ∈ W" "u ∈ R" "u' ∈ R" "R ∈ ℛ"
unfolding cla_def by blast
then have "∀x∈X. 0 ≤ u x" unfolding ℛ_def by fastforce
from region_cover'[OF ℛ_def' this] have R: "[u]⇩ℛ ∈ ℛ" "u ∈ [u]⇩ℛ" by auto
from step_r_complete_aux[OF ℛ_def' A(3) this(2,1) A(1) v'(2)] v'
have *: "[u]⇩ℛ = ([u]⇩ℛ) ∩ {u. u ⊢ g}" "?R' = region_set' ([u]⇩ℛ) r 0" "?R' ∈ ℛ" by auto
from ℛ_def' A(3) have "collect_clkvt (trans_of A) ⊆ X" "finite X"
by (auto elim: valid_abstraction.cases)
with A(1) have r: "set r ⊆ X" unfolding collect_clkvt_def by fastforce
from * v'(1) R(2) have "v' ∈ ?R'" unfolding region_set'_def by auto
moreover have "A,ℛ ⊢ ⟨l,([u]⇩ℛ)⟩ ↝ ⟨l',?R'⟩" using R(1) ℛ_def' A(1,3) v'(2) by auto
thm valid_regions_distinct_spec
with valid_regions_distinct_spec[OF *(3) 1(1) ‹v' ∈ ?R'› 1(3)] region_unique_spec[OF u'(2,4)]
have 2: "?R' = R'" "[u]⇩ℛ = R" by auto
with * u' have *: "[r→0]u' ∈ ?R'" "u' ⊢ g" "[r→0]u' ⊢ inv_of A l'"
unfolding region_set'_def by auto
with A(1) have "A ⊢ ⟨l, u'⟩ → ⟨l',[r→0]u'⟩" apply (intro step.intros(1)) apply rule by auto
moreover from * u'(1) have "[r→0]u' ∈ ?W'" unfolding zone_set_def by auto
ultimately have "R' ⊆ Closure⇩α ?W'" using *(1) 1(1) 2(1) unfolding cla_def by auto
with 1(2) show "v ∈ Closure⇩α ?W'" ..
qed
moreover have "?W' ⊆ ?Z'" using ‹W ⊆ Z› unfolding zone_set_def by auto
ultimately show ?case by meson
qed
lemma steps_z_alt:
"A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z''⟩"
by (induction rule: steps_z.induct) auto
lemma steps_z_alpha_V: "A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ Z ⊆ V ⟹ Z' ⊆ V"
apply (induction rule: steps_z_alpha.induct) using closure_V by auto
lemma steps_z_alpha_closure_involutive':
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z''⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V
⟹ ∃ Z'''. A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z'''⟩ ∧ Closure⇩α Z'' ⊆ Closure⇩α Z''' ∧ Z''' ⊆ Z''"
proof (induction A l Z l' Z' arbitrary: Z'' l'' rule: steps_z_alpha.induct, goal_cases)
case refl from this(1) show ?case by blast
next
case A: (2 A l Z l' Z' l'' Z'' Z''a l''a)
from A(3) obtain 𝒵 where Z'': "Z'' = Closure⇩α 𝒵" "A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',𝒵⟩" by auto
from A(2)[OF Z''(2) A(5,6)] obtain Z''' where Z''':
"A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z'''⟩" "Closure⇩α 𝒵 ⊆ Closure⇩α Z'''" "Z''' ⊆ 𝒵"
by auto
from closure_subs have *:
"Z''' ⊆ Closure⇩α 𝒵"
by (metis A(1,6) Z'''(3) Z''(2) step_z_V steps_z_alpha_V subset_trans)
from A(4) Z'' have "A ⊢ ⟨l'', Closure⇩α 𝒵⟩ ↝ ⟨l''a,Z''a⟩" by auto
from steps_z_alpha_closure_involutive'_aux'[OF this(1) _ A(5) closure_V *] Z'''(2,3) obtain W'
where ***: "A ⊢ ⟨l'', Z'''⟩ ↝ ⟨l''a,W'⟩" "Closure⇩α Z''a ⊆ Closure⇩α W'" "W' ⊆ Z''a"
by (auto simp: closure_involutive)
with Z'''(1) have "A ⊢ ⟨l, Z⟩ ↝* ⟨l''a,W'⟩" by (blast intro: steps_z_alt)
with ***(2,3) show ?case by blast
qed
text ‹Old proof using Bouyer's calculation›
lemma steps_z_alpha_closure_involutive'':
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z''⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V
⟹ ∃ Z'''. A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z'''⟩ ∧ Closure⇩α Z'' ⊆ Closure⇩α Z'''"
proof (induction A l Z l' Z' arbitrary: Z'' l'' rule: steps_z_alpha.induct, goal_cases)
case refl from this(1) show ?case by blast
next
case A: (2 A l Z l' Z' l'' Z'' Z''a l''a)
from A(3) obtain 𝒵 where Z'': "Z'' = Closure⇩α 𝒵" "A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',𝒵⟩" by auto
from A(2)[OF Z''(2) A(5,6)] obtain Z''' where Z''':
"A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z'''⟩" "Closure⇩α 𝒵 ⊆ Closure⇩α Z'''"
by auto
from steps_z_alpha_V[OF A(1,6)] step_z_V[OF Z''(2)] have *: "𝒵 ⊆ V" by blast
from A Z'' have "A ⊢ ⟨l'', Closure⇩α 𝒵⟩ ↝ ⟨l''a,Z''a⟩" by auto
from calc[OF A(5) * this] obtain 𝒵' where **:
"A ⊢ ⟨l'', 𝒵⟩ ↝ ⟨l''a,𝒵'⟩" "Z''a ⊆ Closure⇩α 𝒵'"
by auto
from steps_z_alpha_closure_involutive'_aux[OF this(1) Z'''(2) A(5) *] obtain W' where ***:
"A ⊢ ⟨l'', Z'''⟩ ↝ ⟨l''a,W'⟩" "Closure⇩α 𝒵' ⊆ Closure⇩α W'"
by auto
with Z'''(1) have "A ⊢ ⟨l, Z⟩ ↝* ⟨l''a,W'⟩" by (blast intro: steps_z_alt)
with closure_involutive'[OF **(2)] ***(2) show ?case by blast
qed
lemma steps_z_alpha_closure_involutive:
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z''⟩ ∧ Closure⇩α Z' ⊆ Closure⇩α Z'' ∧ Z'' ⊆ Z'"
proof (induction A l Z l' Z' rule: steps_z_alpha.induct)
case refl show ?case by blast
next
case 2: (step A l Z l' Z' l'' Z'')
then obtain Z''a where *: "A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z''a⟩" "Z'' = Closure⇩α Z''a" by auto
from steps_z_alpha_closure_involutive'[OF 2(1) this(1) 2(4,5)] obtain Z''' where Z''':
"A ⊢ ⟨l, Z⟩ ↝* ⟨l'',Z'''⟩" "Closure⇩α Z''a ⊆ Closure⇩α Z'''" "Z''' ⊆ Z''a" by blast
have "Z''' ⊆ Z''" by (metis *(1,2) 2(1,5) Z'''(3) closure_subs step_z_V steps_z_alpha_V subset_trans)
with * closure_involutive Z''' show ?case by auto
qed
lemma steps_z_V:
"A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z'⟩ ⟹ Z ⊆ V ⟹ Z' ⊆ V"
apply (induction rule: steps_z.induct)
apply blast
using step_z_V by metis
lemma steps_z_alpha_sound:
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z''⟩ ∧ Z'' ≠ {} ∧ Z'' ⊆ Z'"
proof goal_cases
case 1
from steps_z_alpha_closure_involutive[OF 1(1-3)] obtain Z'' where
Z'': "A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z''⟩" "Closure⇩α Z' ⊆ Closure⇩α Z''" "Z'' ⊆ Z'"
by blast
with 1(4) cla_empty_iff[OF steps_z_alpha_V[OF 1(1)], OF 1(3)]
cla_empty_iff[OF steps_z_V, OF this(1) 1(3)] have "Z'' ≠ {}" by auto
with Z'' show ?case by auto
qed
lemma step_z_mono:
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ Z ⊆ W ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩ ∧ Z' ⊆ W'"
proof (cases rule: step_z.cases, assumption, goal_cases)
case A: 1
let ?W' = "(W ∩ {u. u ⊢ inv_of A l})⇧↑ ∩ {u. u ⊢ inv_of A l}"
from A have "A ⊢ ⟨l, W⟩ ↝ ⟨l',?W'⟩" by auto
moreover have "Z' ⊆ ?W'"
apply (subst A(4))
apply (rule subset_int_mono)
apply (rule zone_delay_mono)
apply (rule subset_int_mono)
apply (rule A(2))
done
ultimately show ?thesis by auto
next
case A: (2 g a r)
let ?W' = "zone_set (W ∩ {u. u ⊢ g}) r ∩ {u. u ⊢ inv_of A l'}"
from A have "A ⊢ ⟨l, W⟩ ↝ ⟨l',?W'⟩" by auto
moreover have "Z' ⊆ ?W'"
apply (subst A(3))
apply (rule subset_int_mono)
apply (rule zone_set_mono)
apply (rule subset_int_mono)
apply (rule A(2))
done
ultimately show ?thesis by auto
qed
lemma step_z_alpha_mono:
"A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l',Z'⟩ ⟹ Z ⊆ W ⟹ W ⊆ V ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝⇩α ⟨l',W'⟩ ∧ Z' ⊆ W'"
proof goal_cases
case 1
then obtain Z'' where *: "A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z''⟩" "Z' = Closure⇩α Z''" by auto
from step_z_mono[OF this(1) 1(2)] obtain W' where "A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩" "Z'' ⊆ W'" by auto
moreover with *(2) have "Z' ⊆ Closure⇩α W'" unfolding cla_def by auto
ultimately show ?case by blast
qed
lemma steps_z_alpha_mono:
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'⟩ ⟹ Z ⊆ W ⟹ W ⊆ V ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝⇩α* ⟨l',W'⟩ ∧ Z' ⊆ W'"
proof (induction rule: steps_z_alpha.induct, goal_cases)
case refl then show ?case by auto
next
case (2 A l Z l' Z' l'' Z'')
then obtain W' where "A ⊢ ⟨l, W⟩ ↝⇩α* ⟨l',W'⟩" "Z' ⊆ W'" by auto
with step_z_alpha_mono[OF 2(3) this(2) steps_z_alpha_V[OF this(1) 2(5)]]
show ?case by blast
qed
lemma steps_z_alpha_alt:
"A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝⇩α* ⟨l'', Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l'', Z''⟩"
by (rotate_tac, induction rule: steps_z_alpha.induct) blast+
lemma steps_z_alpha_complete:
"A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z''⟩ ∧ Z' ⊆ Z''"
proof (induction rule: steps_z.induct, goal_cases)
case refl with cla_empty_iff show ?case by blast
next
case (2 A l Z l' Z' l'' Z'')
with step_z_V[OF this(1,5)] obtain Z''' where "A ⊢ ⟨l', Z'⟩ ↝⇩α* ⟨l'',Z'''⟩" "Z'' ⊆ Z'''" by blast
with steps_z_alpha_mono[OF this(1) closure_subs[OF step_z_V[OF 2(1,5)]] closure_V]
obtain W' where "A ⊢ ⟨l', Closure⇩α Z'⟩ ↝⇩α* ⟨l'',W'⟩" " Z'' ⊆ W'" by auto
moreover with 2(1) have "A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l'',W'⟩" by (auto intro: steps_z_alpha_alt)
ultimately show ?case by auto
qed
lemma steps_z_alpha_complete':
"A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z''⟩ ∧ Z'' ≠ {}"
using steps_z_alpha_complete by fast
end
end
Theory Approx_Beta
theory Approx_Beta
imports DBM_Zone_Semantics Regions_Beta Closure
begin
chapter ‹Correctness of ‹β›-approximation from ‹α›-regions›
text ‹Instantiating real›
instantiation real :: linordered_ab_monoid_add
begin
definition
neutral_real: "𝟭 = (0 :: real)"
instance by standard (auto simp: neutral_real)
end
text ‹Merging the locales for the two types of regions›
locale Regions =
fixes X and k :: "'c ⇒ nat" and v :: "'c ⇒ nat" and n :: nat and not_in_X
assumes finite: "finite X"
assumes clock_numbering: "clock_numbering' v n" "∀k≤n. k > 0 ⟶ (∃c ∈ X. v c = k)"
"∀ c ∈ X. v c ≤ n"
assumes not_in_X: "not_in_X ∉ X"
assumes non_empty: "X ≠ {}"
begin
definition ℛ_def: "ℛ ≡ {Regions.region X I r | I r. Regions.valid_region X k I r}"
definition ℛ⇩β_def: "ℛ⇩β ≡ {Regions_Beta.region X I J r | I J r. Regions_Beta.valid_region X k I J r}"
definition V_def: "V ≡ {v . ∀ x ∈ X. v x ≥ 0}"
sublocale alpha_interp: AlphaClosure X k ℛ V by (unfold_locales) (auto simp: finite ℛ_def V_def)
sublocale beta_interp: Beta_Regions' X k ℛ⇩β V v n not_in_X
using finite non_empty clock_numbering not_in_X by (unfold_locales) (auto simp: ℛ⇩β_def V_def)
abbreviation "Approx⇩β ≡ beta_interp.Approx⇩β"
section ‹Preparing Bouyer's Theorem›
lemma region_dbm:
assumes "R ∈ ℛ"
defines "v' ≡ λ i. THE c. c ∈ X ∧ v c = i"
obtains M
where"[M]⇘v,n⇙ = R"
and "∀ i ≤ n. ∀ j ≤ n. M i 0 = ∞ ∧ j > 0 ∧ i ≠ j⟶ M i j = ∞ ∧ M j i = ∞"
and "∀ i ≤ n. M i i = Le 0"
and "∀ i ≤ n. ∀ j ≤ n. i > 0 ∧ j > 0 ∧ M i 0 ≠ ∞ ∧ M j 0 ≠ ∞ ⟶ (∃ d :: int.
(- k (v' j) ≤ d ∧ d ≤ k (v' i) ∧ M i j = Le d ∧ M j i = Le (-d))
∨ (- k (v' j) ≤ d - 1 ∧ d ≤ k (v' i) ∧ M i j = Lt d ∧ M j i = Lt (-d + 1)))"
and "∀ i ≤ n. i > 0 ∧ M i 0 ≠ ∞ ⟶
(∃ d :: int. d ≤ k (v' i) ∧ d ≥ 0
∧ (M i 0 = Le d ∧ M 0 i = Le (-d) ∨ M i 0 = Lt d ∧ M 0 i = Lt (-d + 1)))"
and "∀ i ≤ n. i > 0 ⟶ (∃ d :: int. - k (v' i) ≤ d ∧ d ≤ 0 ∧ (M 0 i = Le d ∨ M 0 i = Lt d))"
and "∀ i. ∀ j. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
and "∀ i ≤ n. ∀ j ≤ n. M i j ≠ ∞ ∧ i > 0 ∧ j > 0 ⟶
(∃ d:: int. (M i j = Le d ∨ M i j = Lt d) ∧ (- k (v' j)) ≤ d ∧ d ≤ k (v' i))"
proof -
from assms obtain I r where R: "R = region X I r" "valid_region X k I r" unfolding ℛ_def by blast
let ?X⇩0 = "{x ∈ X. ∃d. I x = Regions.intv.Intv d}"
define f where "f x = (if isIntv (I x) then Lt (intv_const (I x) + 1)
else if isConst (I x) then Le (intv_const (I x))
else ∞)" for x
define g where "g x = (if isIntv (I x) then Lt (- intv_const (I x))
else if isConst (I x) then Le (- intv_const (I x))
else Lt (- k x))" for x
define h where "h x y = (if isIntv (I x) ∧ isIntv (I y) then
if (y, x) ∈ r ∧ (x, y) ∉ r then Lt (int (intv_const (I x)) - intv_const (I y) + 1)
else if (x, y) ∈ r ∧ (y, x) ∉ r then Lt (int (intv_const (I x)) - intv_const (I y))
else Le (int (intv_const (I x)) - intv_const (I y))
else if isConst (I x) ∧ isConst (I y) then Le (int (intv_const (I x)) - intv_const (I y))
else if isIntv (I x) ∧ isConst (I y) then Lt (int (intv_const (I x)) + 1 - intv_const (I y))
else if isConst (I x) ∧ isIntv (I y) then Lt (int (intv_const (I x)) - intv_const (I y))
else ∞)" for x y
let ?M = "λ i j. if i = 0 then if j = 0 then Le 0 else g (v' j)
else if j = 0 then f (v' i) else if i = j then Le 0 else h (v' i) (v' j)"
have "[?M]⇘v,n⇙ ⊆ R"
proof
fix u assume u: "u ∈ [?M]⇘v,n⇙"
show "u ∈ R" unfolding R
proof (standard, goal_cases)
case 1
show ?case
proof
fix c assume c: "c ∈ X"
with clock_numbering have c2: "v c ≤ n" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
with u have "dbm_entry_val u None (Some c) (g c)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
then show "0 ≤ u c" by (cases "isIntv (I c)"; cases "isConst (I c)") (auto simp: g_def)
qed
next
case 2
show ?case
proof
fix c assume c: "c ∈ X"
with clock_numbering have c2: "v c ≤ n" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
with u have *: "dbm_entry_val u None (Some c) (g c)" "dbm_entry_val u (Some c) None (f c)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
show "intv_elem c u (I c)"
proof (cases "I c")
case (Const d)
then have "¬ isIntv (I c)" "isConst (I c)" by auto
with * Const show ?thesis unfolding g_def f_def using Const by auto
next
case (Intv d)
then have "isIntv (I c)" "¬ isConst (I c)" by auto
with * Intv show ?thesis unfolding g_def f_def by auto
next
case (Greater d)
then have "¬ isIntv (I c)" "¬ isConst (I c)" by auto
with * Greater R(2) c show ?thesis unfolding g_def f_def by fastforce
qed
qed
next
show "?X⇩0 = ?X⇩0" ..
show "∀x ∈ ?X⇩0. ∀ y ∈ ?X⇩0. (x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)"
proof (standard, standard)
fix x y assume A: "x ∈ ?X⇩0" "y ∈ ?X⇩0"
show "(x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)"
proof (cases "x = y")
case True
have "refl_on ?X⇩0 r" using R(2) by auto
with A True show ?thesis unfolding refl_on_def by auto
next
case False
from A obtain d d' where AA:
"I x = Intv d" "I y = Intv d'" "isIntv (I x)" "isIntv (I y)" "¬ isConst (I x)" "¬ isConst (I y)"
by auto
from A False clock_numbering have B:
"v x ≤ n" "v x > 0" "v' (v x) = x" "v y ≤ n" "v y > 0" "v' (v y) = y" "v x ≠ v y"
unfolding v'_def by auto
with u have *:
"dbm_entry_val u (Some x) (Some y) (h x y)" "dbm_entry_val u (Some y) (Some x) (h y x)"
"dbm_entry_val u None (Some x) (g x)" "dbm_entry_val u (Some x) None (f x)"
"dbm_entry_val u None (Some y) (g y)" "dbm_entry_val u (Some y) None (f y)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by force+
show "(x, y) ∈ r ⟷ frac (u x) ≤ frac (u y)"
proof
assume C: "(x, y) ∈ r"
show "frac (u x) ≤ frac (u y)"
proof (cases "(y, x) ∈ r")
case False
with * AA C have **:
"u x - u y < int d - d'"
"d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
unfolding f_def g_def h_def by auto
from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) show
"frac (u x) ≤ frac (u y)"
by simp
next
case True
with * AA C have **:
"u x - u y ≤ int d - d'"
"d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
unfolding f_def g_def h_def by auto
from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) show
"frac (u x) ≤ frac (u y)"
by simp
qed
next
assume "frac (u x) ≤ frac (u y)"
show "(x, y) ∈ r"
proof (rule ccontr)
assume C: "(x,y) ∉ r"
moreover from R(2) have "total_on ?X⇩0 r" by auto
ultimately have "(y, x) ∈ r" using False A unfolding total_on_def by auto
with *(2-) AA C have **:
"u y - u x < int d' - d"
"d < u x" "u x < d + 1" "d' < u y" "u y < d' + 1"
unfolding f_def g_def h_def by auto
from nat_intv_frac_decomp[OF **(2,3)] nat_intv_frac_decomp[OF **(4,5)] **(1) have
"frac (u y) < frac (u x)"
by simp
with ‹frac _ ≤ _› show False by auto
qed
qed
qed
qed
qed
qed
moreover have "R ⊆ [?M]⇘v,n⇙"
proof
fix u assume u: "u ∈ R"
show "u ∈ [?M]⇘v,n⇙" unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (safe, goal_cases)
case 1 then show ?case by auto
next
case (2 c)
with clock_numbering have "c ∈ X" by metis
with clock_numbering have *: "c ∈ X" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
with R u have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
then have "dbm_entry_val u None (Some c) (g c)" unfolding g_def by (cases "I c") auto
with * show ?case by auto
next
case (3 c)
with clock_numbering have "c ∈ X" by metis
with clock_numbering have *: "c ∈ X" "v c > 0" "v' (v c) = c" unfolding v'_def by auto
with R u have "intv_elem c u (I c)" "valid_intv (k c) (I c)" by auto
then have "dbm_entry_val u (Some c) None (f c)" unfolding f_def by (cases "I c") auto
with * show ?case by auto
next
case (4 c1 c2)
with clock_numbering have "c1 ∈ X" "c2 ∈ X" by metis+
with clock_numbering have *:
"c1 ∈ X" "v c1 > 0" "v' (v c1) = c1" "c2 ∈ X" "v c2 > 0" "v' (v c2) = c2"
unfolding v'_def by auto
with R u have
"intv_elem c1 u (I c1)" "valid_intv (k c1) (I c1)"
"intv_elem c2 u (I c2)" "valid_intv (k c2) (I c2)"
by auto
then have "dbm_entry_val u (Some c1) (Some c2) (h c1 c2)" unfolding h_def
proof(cases "I c1", cases "I c2", fastforce+, cases "I c2", fastforce, goal_cases)
case (1 d d')
then show ?case
proof (cases "(c2, c1) ∈ r", goal_cases)
case 1
show ?case
proof (cases "(c1, c2) ∈ r")
case True
with 1 *(1,4) R(1) u have "frac (u c1) = frac (u c2)" by auto
with 1 have "u c1 - u c2 = real d - d'" by (fastforce dest: nat_intv_frac_decomp)
with 1 show ?thesis by auto
next
case False with 1 show ?thesis by auto
qed
next
case 2
show ?case
proof (cases "c1 = c2")
case True then show ?thesis by auto
next
case False
with 2 R(2) *(1,4) have "(c1, c2) ∈ r" by (fastforce simp: total_on_def)
with 2 *(1,4) R(1) u have "frac (u c1) < frac (u c2)" by auto
with 2 have "u c1 - u c2 < real d - d'" by (fastforce dest: nat_intv_frac_decomp)
with 2 show ?thesis by auto
qed
qed
qed fastforce+
then show ?case
proof (cases "v c1 = v c2", goal_cases)
case True with * clock_numbering have "c1 = c2" by auto
then show ?thesis by auto
next
case 2 with * show ?case by auto
qed
qed
qed
ultimately have "[?M]⇘v,n⇙ = R" by blast
moreover have "∀ i ≤ n. ∀ j ≤ n. ?M i 0 = ∞ ∧ j > 0 ∧ i ≠ j ⟶ ?M i j = ∞ ∧ ?M j i = ∞"
unfolding f_def h_def by auto
moreover have "∀ i ≤ n. ?M i i = Le 0" by auto
moreover
{ fix i j assume A: "i ≤ n" "j ≤ n" "i > 0" "j > 0" "?M i 0 ≠ ∞" "?M j 0 ≠ ∞"
with clock_numbering(2) obtain c1 c2 where B: "v c1 = i" "v c2 = j" "c1 ∈ X" "c2 ∈ X" by meson
with clock_numbering(1) A have C: "v' i = c1" "v' j = c2" unfolding v'_def by force+
from R(2) B have valid: "valid_intv (k c1) (I c1)" "valid_intv (k c2) (I c2)" by auto
have "∃ d :: int. (- k (v' j) ≤ d ∧ d ≤ k (v' i) ∧ ?M i j = Le d ∧ ?M j i = Le (-d)
∨ (- k (v' j) ≤ d - 1 ∧ d ≤ k (v' i) ∧ ?M i j = Lt d ∧ ?M j i = Lt (-d + 1)))"
proof (cases "i = j")
case True
then show ?thesis by auto
next
case False
then show ?thesis
proof (cases "I c1", goal_cases)
case 1
then show ?case
proof (cases "I c2")
case Const
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from Const 1 have "isConst (I c1)" "isConst (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Intv
let ?d = "int(intv_const (I c1)) - int (intv_const (I c2))"
from Intv 1 have "isConst (I c1)" "isIntv (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Greater
then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
with A 1(1) C have False unfolding f_def by simp
then show ?thesis by fast
qed
next
case 2
then show ?case
proof (cases "I c2")
case Const
let ?d = "int (intv_const (I c1)) + 1 - int (intv_const (I c2))"
from Const 2 have "isIntv (I c1)" "isConst (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Intv
with 2 have *: "isIntv (I c1)" "isIntv (I c2)" by auto
from Intv A(1-4) C show ?thesis apply simp
proof (standard, goal_cases)
case 1
show ?case
proof (cases "(c2, c1) ∈ r")
case True
note T = this
show ?thesis
proof (cases "(c1, c2) ∈ r")
case True
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from True T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case False
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2)) + 1"
from False T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
qed
next
case False
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from False * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
qed
qed
next
case Greater
then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
with A 2(1) C have False unfolding f_def by simp
then show ?thesis by fast
qed
next
case 3
then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
with A 3(1) C have False unfolding f_def by simp
then show ?thesis by fast
qed
qed
}
moreover
{ fix i assume A: "i ≤ n" "i > 0" "?M i 0 ≠ ∞"
with clock_numbering(2) obtain c1 where B: "v c1 = i" "c1 ∈ X" by meson
with clock_numbering(1) A have C: "v' i = c1" unfolding v'_def by force+
from R(2) B have valid: "valid_intv (k c1) (I c1)" by auto
have "∃ d :: int. d ≤ k (v' i) ∧ d ≥ 0
∧ (?M i 0 = Le d ∧ ?M 0 i = Le (-d) ∨ ?M i 0 = Lt d ∧ ?M 0 i = Lt (-d + 1))"
proof (cases "i = 0")
case True
then show ?thesis by auto
next
case False
then show ?thesis
proof (cases "I c1", goal_cases)
case 1
let ?d = "int (intv_const (I c1))"
from 1 have "isConst (I c1)" "¬ isIntv (I c1)" by auto
with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
next
case 2
let ?d = "int (intv_const (I c1)) + 1"
from 2 have "isIntv(I c1)" "¬ isConst (I c1)" by auto
with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
next
case 3
then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
with A 3(1) C have False unfolding f_def by simp
then show ?thesis by fast
qed
qed
}
moreover
{ fix i assume A: "i ≤ n" "i > 0"
with clock_numbering(2) obtain c1 where B: "v c1 = i" "c1 ∈ X" by meson
with clock_numbering(1) A have C: "v' i = c1" unfolding v'_def by force+
from R(2) B have valid: "valid_intv (k c1) (I c1)" by auto
have "∃ d :: int. - k (v' i) ≤ d ∧ d ≤ 0 ∧ (?M 0 i = Le d ∨ ?M 0 i = Lt d)"
proof (cases "i = 0")
case True
then show ?thesis by auto
next
case False
then show ?thesis
proof (cases "I c1", goal_cases)
case 1
let ?d = "- int (intv_const (I c1))"
from 1 have "isConst (I c1)" "¬ isIntv (I c1)" by auto
with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
next
case 2
let ?d = "- int (intv_const (I c1))"
from 2 have "isIntv(I c1)" "¬ isConst (I c1)" by auto
with A C valid show ?thesis unfolding f_def g_def by (intro exI[where x = ?d]) auto
next
case 3
let ?d = "- (k c1)"
from 3 have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
with A C show ?thesis unfolding g_def by (intro exI[where x = ?d]) auto
qed
qed
}
moreover have "∀ i. ∀ j. ?M i j ≠ ∞ ⟶ get_const (?M i j) ∈ ℤ" unfolding f_def g_def h_def by auto
moreover have "∀ i ≤ n. ∀ j ≤ n. i > 0 ∧ j > 0 ∧ ?M i j ≠ ∞
⟶ (∃ d:: int. (?M i j = Le d ∨ ?M i j = Lt d) ∧ (- k (v' j)) ≤ d ∧ d ≤ k (v' i))"
proof (auto, goal_cases)
case A: (1 i j)
with clock_numbering(2) obtain c1 c2 where B: "v c1 = i" "c1 ∈ X" "v c2 = j" "c2 ∈ X" by meson
with clock_numbering(1) A have C: "v' i = c1" "v' j = c2" unfolding v'_def by force+
from R(2) B have valid: "valid_intv (k c1) (I c1)" "valid_intv (k c2) (I c2)" by auto
with A B C show ?case
proof (simp, goal_cases)
case 1
show ?case
proof (cases "I c1", goal_cases)
case 1
then show ?case
proof (cases "I c2")
case Const
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from Const 1 have "isConst (I c1)" "isConst (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Intv
let ?d = "int(intv_const (I c1)) - int (intv_const (I c2))"
from Intv 1 have "isConst (I c1)" "isIntv (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Greater
then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
with A 1(1) C show ?thesis unfolding h_def by simp
qed
next
case 2
then show ?case
proof (cases "I c2")
case Const
let ?d = "int (intv_const (I c1)) + 1 - int (intv_const (I c2))"
from Const 2 have "isIntv (I c1)" "isConst (I c2)" by auto
with A(1-4) C valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case Intv
with 2 have *: "isIntv (I c1)" "isIntv (I c2)" by auto
from Intv A(1-4) C show ?thesis
proof goal_cases
case 1
show ?case
proof (cases "(c2, c1) ∈ r")
case True
note T = this
show ?thesis
proof (cases "(c1, c2) ∈ r")
case True
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from True T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
next
case False
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2)) + 1"
from False T * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
qed
next
case False
let ?d = "int (intv_const (I c1)) - int (intv_const (I c2))"
from False * valid show ?thesis unfolding h_def by (intro exI[where x = ?d]) auto
qed
qed
next
case Greater
then have "¬ isIntv (I c2)" "¬ isConst (I c2)" by auto
with A 2(1) C show ?thesis unfolding h_def by simp
qed
next
case 3
then have "¬ isIntv (I c1)" "¬ isConst (I c1)" by auto
with A 3(1) C show ?thesis unfolding h_def by simp
qed
qed
qed
moreover show ?thesis
apply (rule that)
apply (rule calculation(1))
apply (rule calculation(2))
apply (rule calculation(3))
apply (blast intro: calculation)+
apply (rule calculation(7))
using calculation(8) apply blast
done
qed
lemma len_inf_elem:
"(a, b) ∈ set (arcs i j xs) ⟹ M a b = ∞ ⟹ len M i j xs = ∞"
apply (induction rule: arcs.induct)
apply (auto simp: mult)
apply (rename_tac a' b' x xs)
apply (case_tac "M a' x")
by auto
lemma dbm_add_strict_right_mono_neutral: "a < Le d ⟹ a + Le (-d) < Le 0"
unfolding less mult by (cases a) (auto elim!: dbm_lt.cases)
lemma dbm_lt_not_inf_less[intro]: "A ≠ ∞ ⟹ A ≺ ∞" by (cases A) auto
lemma add_inf[simp]:
"a + ∞ = ∞" "∞ + a = ∞"
unfolding mult by (cases a) auto
lemma inf_lt[simp,dest!]:
"∞ < x ⟹ False"
by (cases x) (auto simp: less)
lemma zone_diag_lt:
assumes "a ≤ n" "b ≤ n" and C: "v c1 = a" "v c2 = b" and not0: "a > 0" "b > 0"
shows "[(λ i j. if i = a ∧ j = b then Lt d else ∞)]⇘v,n⇙ = {u. u c1 - u c2 < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (standard, goal_cases)
case 1
then show ?case using ‹a ≤ n› ‹b ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case 2 with not0 show ?case by auto
next
case 3 with not0 show ?case by auto
next
case (4 u' y z)
show ?case
proof (cases "v y = a ∧ v z = b")
case True
with 4 clock_numbering C ‹a ≤ n› ‹b ≤ n› have "u' y - u' z < d" by metis
with True show ?thesis by auto
next
case False then show ?thesis by auto
qed
qed
qed
lemma zone_diag_le:
assumes "a ≤ n" "b ≤ n" and C: "v c1 = a" "v c2 = b" and not0: "a > 0" "b > 0"
shows "[(λ i j. if i = a ∧ j = b then Le d else ∞)]⇘v,n⇙ = {u. u c1 - u c2 ≤ d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
case 1
then show ?case using ‹a ≤ n› ‹b ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case 2 with not0 show ?case by auto
next
case 3 with not0 show ?case by auto
next
case (4 u' y z)
show ?case
proof (cases "v y = a ∧ v z = b")
case True
with 4 clock_numbering C ‹a ≤ n› ‹b ≤ n› have "u' y - u' z ≤ d" by metis
with True show ?thesis by auto
next
case False then show ?thesis by auto
qed
qed
qed
lemma zone_diag_lt_2:
assumes "a ≤ n" and C: "v c = a" and not0: "a > 0"
shows "[(λ i j. if i = a ∧ j = 0 then Lt d else ∞)]⇘v,n⇙ = {u. u c < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
case 1
then show ?case using ‹a ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case 2 with not0 show ?case by auto
next
case (3 u c)
show ?case
proof (cases "v c = a")
case False then show ?thesis by auto
next
case True
with 3 clock_numbering C ‹a ≤ n› have "u c < d" by metis
with C show ?thesis by auto
qed
next
case (4 u' y z)
from clock_numbering(1) have "0 < v z" by auto
then show ?case by auto
qed
qed
lemma zone_diag_le_2:
assumes "a ≤ n" and C: "v c = a" and not0: "a > 0"
shows "[(λ i j. if i = a ∧ j = 0 then Le d else ∞)]⇘v,n⇙ = {u. u c ≤ d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
case 1
then show ?case using ‹a ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case 2 with not0 show ?case by auto
next
case (3 u c)
show ?case
proof (cases "v c = a")
case False then show ?thesis by auto
next
case True
with 3 clock_numbering C ‹a ≤ n› have "u c ≤ d" by metis
with C show ?thesis by auto
qed
next
case (4 u' y z)
from clock_numbering(1) have "0 < v z" by auto
then show ?case by auto
qed
qed
lemma zone_diag_lt_3:
assumes "a ≤ n" and C: "v c = a" and not0: "a > 0"
shows "[(λ i j. if i = 0 ∧ j = a then Lt d else ∞)]⇘v,n⇙ = {u. - u c < d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
case 1
then show ?case using ‹a ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case (2 u c)
show ?case
proof (cases "v c = a", goal_cases)
case False then show ?thesis by auto
next
case True
with 2 clock_numbering C ‹a ≤ n› have "- u c < d" by metis
with C show ?thesis by auto
qed
next
case (3 u) with not0 show ?case by auto
next
case (4 u' y z)
from clock_numbering(1) have "0 < v y" by auto
then show ?case by auto
qed
qed
lemma len_int_closed:
"∀ i j. (M i j :: real) ∈ ℤ ⟹ len M i j xs ∈ ℤ"
by (induction xs arbitrary: i) auto
lemma get_const_distr:
"a ≠ ∞ ⟹ b ≠ ∞ ⟹ get_const (a + b) = get_const a + get_const b"
by (cases a) (cases b, auto simp: mult)+
lemma len_int_dbm_closed:
"∀ (i, j) ∈ set (arcs i j xs). (get_const (M i j) :: real) ∈ ℤ ∧ M i j ≠ ∞
⟹ get_const (len M i j xs) ∈ ℤ ∧ len M i j xs ≠ ∞"
by (induction xs arbitrary: i) (auto simp: get_const_distr, simp add: dbm_add_not_inf mult)
lemma zone_diag_le_3:
assumes "a ≤ n" and C: "v c = a" and not0: "a > 0"
shows "[(λ i j. if i = 0 ∧ j = a then Le d else ∞)]⇘v,n⇙ = {u. - u c ≤ d}"
unfolding DBM_zone_repr_def DBM_val_bounded_def
proof (rule, goal_cases)
case 1
then show ?case using ‹a ≤ n› C by fastforce
next
case 2
then show ?case
proof (safe, goal_cases)
case 1 from not0 show ?case unfolding dbm_le_def by auto
next
case (2 u c)
show ?case
proof (cases "v c = a")
case False then show ?thesis by auto
next
case True
with 2 clock_numbering C ‹a ≤ n› have "- u c ≤ d" by metis
with C show ?thesis by auto
qed
next
case (3 u) with not0 show ?case by auto
next
case (4 u' y z)
from clock_numbering(1) have "0 < v y" by auto
then show ?case by auto
qed
qed
lemma dbm_lt':
assumes "[M]⇘v,n⇙ ⊆ V" "M a b ≤ Lt d" "a ≤ n" "b ≤ n" "v c1 = a" "v c2 = b" "a > 0" "b > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 < d}"
proof -
from assms have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = a ∧ j = b then Lt d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_lt[OF ‹a ≤ n› ‹b ≤ n› assms(5-)]
have "[(λ i j. if i = a ∧ j = b then Lt d else ∞)]⇘v,n⇙ = {u. u c1 - u c2 < d}" by blast
moreover from assms have "[M]⇘v,n⇙ ⊆ V" by auto
ultimately show ?thesis by auto
qed
lemma dbm_lt'2:
assumes "[M]⇘v,n⇙ ⊆ V" "M a 0 ≤ Lt d" "a ≤ n" "v c1 = a" "a > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 < d}"
proof -
from assms(2) have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = a ∧ j = 0 then Lt d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_lt_2[OF ‹a ≤ n› assms(4,5)]
have "[(λ i j. if i = a ∧ j = 0 then Lt d else ∞)]⇘v,n⇙ = {u. u c1 < d}" by blast
ultimately show ?thesis using assms(1) by auto
qed
lemma dbm_lt'3:
assumes "[M]⇘v,n⇙ ⊆ V" "M 0 a ≤ Lt d" "a ≤ n" "v c1 = a" "a > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. - u c1 < d}"
proof -
from assms(2) have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = 0 ∧ j = a then Lt d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_lt_3[OF ‹a ≤ n› assms(4,5)]
have "[(λ i j. if i = 0 ∧ j = a then Lt d else ∞)]⇘v,n⇙ = {u. - u c1 < d}" by blast
ultimately show ?thesis using assms(1) by auto
qed
lemma dbm_le':
assumes "[M]⇘v,n⇙ ⊆ V" "M a b ≤ Le d" "a ≤ n" "b ≤ n" "v c1 = a" "v c2 = b" "a > 0" "b > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 ≤ d}"
proof -
from assms have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = a ∧ j = b then Le d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_le[OF ‹a ≤ n› ‹b ≤ n› assms(5-)]
have "[(λ i j. if i = a ∧ j = b then Le d else ∞)]⇘v,n⇙ = {u. u c1 - u c2 ≤ d}" by blast
moreover from assms have "[M]⇘v,n⇙ ⊆ V" by auto
ultimately show ?thesis by auto
qed
lemma dbm_le'2:
assumes "[M]⇘v,n⇙ ⊆ V" "M a 0 ≤ Le d" "a ≤ n" "v c1 = a" "a > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 ≤ d}"
proof -
from assms(2) have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = a ∧ j = 0 then Le d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_le_2[OF ‹a ≤ n› assms(4,5)]
have "[(λ i j. if i = a ∧ j = 0 then Le d else ∞)]⇘v,n⇙ = {u. u c1 ≤ d}" by blast
ultimately show ?thesis using assms(1) by auto
qed
lemma dbm_le'3:
assumes "[M]⇘v,n⇙ ⊆ V" "M 0 a ≤ Le d" "a ≤ n" "v c1 = a" "a > 0"
shows "[M]⇘v,n⇙ ⊆ {u ∈ V. - u c1 ≤ d}"
proof -
from assms(2) have "[M]⇘v,n⇙ ⊆ [(λ i j. if i = 0 ∧ j = a then Le d else ∞)]⇘v,n⇙"
apply safe
apply (rule DBM_le_subset)
unfolding less_eq dbm_le_def by auto
moreover from zone_diag_le_3[OF ‹a ≤ n› assms(4,5)]
have "[(λ i j. if i = 0 ∧ j = a then Le d else ∞)]⇘v,n⇙ = {u. - u c1 ≤ d}" by blast
ultimately show ?thesis using assms(1) by auto
qed
lemma int_zone_dbm:
assumes "∀ (_,d) ∈ collect_clock_pairs cc. d ∈ ℤ" "∀ c ∈ collect_clks cc. v c ≤ n"
obtains M where "{u. u ⊢ cc} = [M]⇘v,n⇙" and "dbm_int M n"
using int_zone_dbm[OF _ assms] clock_numbering(1) by auto
lemma non_empty_dbm_diag_set':
assumes "clock_numbering' v n" "∀i≤n. ∀j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
"[M]⇘v,n⇙ ≠ {}"
obtains M' where "[M]⇘v,n⇙ = [M']⇘v,n⇙ ∧ (∀i≤n. ∀j≤n. M' i j ≠ ∞ ⟶ get_const (M' i j) ∈ ℤ)
∧ (∀ i ≤ n. M' i i = 𝟭)"
proof -
let ?M = "λi j. if i = j then 𝟭 else M i j"
from non_empty_dbm_diag_set[OF assms(1,3)] have "[M]⇘v,n⇙ = [?M]⇘v,n⇙" by auto
moreover from assms(2) have "∀i≤n. ∀j≤n. ?M i j ≠ ∞ ⟶ get_const (?M i j) ∈ ℤ"
unfolding neutral by auto
moreover have "∀ i ≤ n. ?M i i = 𝟭" by auto
ultimately show ?thesis by (auto intro: that)
qed
lemma dbm_entry_int:
"x ≠ ∞ ⟹ get_const x ∈ ℤ ⟹ ∃ d :: int. x = Le d ∨ x = Lt d"
apply (cases x) using Ints_cases by auto
abbreviation "vabstr ≡ beta_interp.vabstr"
section ‹Bouyer's Main Theorem›
theorem region_zone_intersect_empty_approx_correct:
assumes "R ∈ ℛ" "Z ⊆ V" "R ∩ Z = {}" "vabstr Z M"
shows "R ∩ Approx⇩β Z = {}"
proof -
define v' where "v' i = (THE c. c ∈ X ∧ v c = i)" for i
from region_dbm[OF assms(1)] obtain M⇩R where M⇩R:
"[M⇩R]⇘v,n⇙ = R" "∀i≤n. ∀j≤n. M⇩R i 0 = ∞ ∧ 0 < j ∧ i ≠ j ⟶ M⇩R i j = ∞ ∧ M⇩R j i = ∞"
"∀i≤n. M⇩R i i = Le 0"
"∀i≤n. ∀j≤n. 0 < i ∧ 0 < j ∧ M⇩R i 0 ≠ ∞ ∧ M⇩R j 0 ≠ ∞ ⟶
(∃d. - int (k (THE c. c ∈ X ∧ v c = j)) ≤ d ∧ d ≤ int (k (THE c. c ∈ X ∧ v c = i))
∧ M⇩R i j = Le d ∧ M⇩R j i = Le (real_of_int (- d))
∨ - int (k (THE c. c ∈ X ∧ v c = j)) ≤ d - 1 ∧ d ≤ int (k (THE c. c ∈ X ∧ v c = i))
∧ M⇩R i j = Lt d ∧ M⇩R j i = Lt (real_of_int (- d + 1)))"
"∀i≤n. 0 < i ∧ M⇩R i 0 ≠ ∞ ⟶ (∃d≤int (k (THE c. c ∈ X ∧ v c = i)). d ≥ 0 ∧
(M⇩R i 0 = Le d ∧ M⇩R 0 i = Le (real_of_int (- d)) ∨ M⇩R i 0 = Lt d ∧ M⇩R 0 i = Lt (real_of_int (- d + 1))))"
"∀i≤n. 0 < i ⟶ (∃d≥- int (k (THE c. c ∈ X ∧ v c = i)). d ≤ 0 ∧ (M⇩R 0 i = Le d ∨ M⇩R 0 i = Lt d))"
"∀i j. M⇩R i j ≠ ∞ ⟶ get_const (M⇩R i j) ∈ ℤ"
"∀i≤n. ∀j≤n. M⇩R i j ≠ ∞ ∧ 0 < i ∧ 0 < j ⟶ (∃d. (M⇩R i j = Le d ∨ M⇩R i j = Lt d)
∧ - int (k (THE c. c ∈ X ∧ v c = j)) ≤ d ∧ d ≤ int (k (THE c. c ∈ X ∧ v c = i)))"
.
show ?thesis
proof (cases "R = {}")
case True then show ?thesis by auto
next
case False
from clock_numbering(2) have cn_weak: "∀k≤n. 0 < k ⟶ (∃ c. v c = k)" by auto
show ?thesis
proof (cases "Z = {}")
case True
then show ?thesis using beta_interp.apx_empty by blast
next
case False
from assms(4) have
"Z = [M]⇘v,n⇙" "∀ i≤n. ∀ j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
by auto
from this(1) non_empty_dbm_diag_set'[OF clock_numbering(1) this(2)] ‹Z ≠ {}› obtain M where M:
"Z = [M]⇘v,n⇙ ∧ (∀i≤n. ∀j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ) ∧ (∀i≤n. M i i = 𝟭)"
by auto
with not_empty_cyc_free[OF cn_weak] False have "cyc_free M n" by auto
then have "cycle_free M n" using cycle_free_diag_equiv by auto
from M have "Z = [FW M n]⇘v,n⇙" unfolding neutral by (auto intro!: FW_zone_equiv[OF cn_weak])
moreover from fw_canonical[OF ‹cycle_free M _›] M have "canonical (FW M n) n" unfolding neutral by auto
moreover from FW_int_preservation M have
"∀i≤n. ∀j≤n. FW M n i j ≠ ∞ ⟶ get_const (FW M n i j) ∈ ℤ"
by auto
ultimately obtain M where M:
"[M]⇘v,n⇙ = Z" "canonical M n" "∀i≤n. ∀j≤n. M i j ≠ ∞ ⟶ get_const (M i j) ∈ ℤ"
by blast
let ?M = "λ i j. min (M i j) (M⇩R i j)"
from M(1) M⇩R(1) assms have "[M]⇘v,n⇙ ∩ [M⇩R]⇘v,n⇙ = {}" by auto
moreover from DBM_le_subset[folded less_eq, of n ?M M] have "[?M]⇘v,n⇙ ⊆ [M]⇘v,n⇙" by auto
moreover from DBM_le_subset[folded less_eq, of n ?M M⇩R] have "[?M]⇘v,n⇙ ⊆ [M⇩R]⇘v,n⇙" by auto
ultimately have "[?M]⇘v,n⇙ = {}" by blast
then have "¬ cyc_free ?M n" using cyc_free_not_empty[of n ?M v] clock_numbering(1) by auto
then obtain i xs where xs: "i ≤ n" "set xs ⊆ {0..n}" "len ?M i i xs < 𝟭" by auto
from this(1,2) canonical_shorten_rotate_neg_cycle[OF M(2) this(2,1,3)] obtain i ys where ys:
"len ?M i i ys < 𝟭"
"set ys ⊆ {0..n}" "successive (λ(a, b). ?M a b = M a b) (arcs i i ys)" "i ≤ n"
and distinct: "distinct ys" "i ∉ set ys"
and cycle_closes: "ys ≠ [] ⟶ ?M i (hd ys) ≠ M i (hd ys) ∨ ?M (last ys) i ≠ M (last ys) i"
by fastforce
have one_M_aux:
"len ?M i j ys = len M⇩R i j ys" if "∀ (a,b) ∈ set (arcs i j ys). M a b ≥ M⇩R a b" for j
using that by (induction ys arbitrary: i) (auto simp: min_def)
have one_M: "∃ (a,b) ∈ set (arcs i i ys). M a b < M⇩R a b"
proof (rule ccontr, goal_cases)
case 1
then have "∀(a, b)∈set (arcs i i ys). M⇩R a b ≤ M a b" by auto
from one_M_aux[OF this] have "len ?M i i ys = len M⇩R i i ys" .
with Nil ys(1) xs(3) have "len M⇩R i i ys < 𝟭" by simp
from DBM_val_bounded_neg_cycle[OF _ ‹i ≤ n› ‹set ys ⊆ _› this cn_weak]
have "[M⇩R]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
with ‹R ≠ {}› M⇩R(1) show False by auto
qed
have one_M_R_aux:
"len ?M i j ys = len M i j ys" if "∀ (a,b) ∈ set (arcs i j ys). M a b ≤ M⇩R a b" for j
using that by (induction ys arbitrary: i) (auto simp: min_def)
have one_M_R: "∃ (a,b) ∈ set (arcs i i ys). M a b > M⇩R a b"
proof (rule ccontr, goal_cases)
case 1
then have "∀(a, b)∈set (arcs i i ys). M⇩R a b ≥ M a b" by auto
from one_M_R_aux[OF this] have "len ?M i i ys = len M i i ys" .
with Nil ys(1) xs(3) have "len M i i ys < 𝟭" by simp
from DBM_val_bounded_neg_cycle[OF _ ‹i ≤ n› ‹set ys ⊆ _› this cn_weak]
have "[M]⇘v,n⇙ = {}" unfolding DBM_zone_repr_def by auto
with ‹Z ≠ {}› M(1) show False by auto
qed
have 0: "(0,0) ∉ set (arcs i i ys)"
proof (cases "ys = []")
case False with distinct show ?thesis using arcs_distinct1 by blast
next
case True with ys(1) have "?M i i < 𝟭" by auto
then have "M i i < 𝟭 ∨ M⇩R i i < 𝟭" by (simp add: min_less_iff_disj)
from one_M one_M_R True show ?thesis by auto
qed
{ fix a b assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "a > 0"
from aux1[OF ys(4,4,2) A] have C2: "a ≤ n" by auto
then obtain c1 where C: "v c1 = a" "c1 ∈ X"
using clock_numbering(2) not0 unfolding v'_def by meson
then have "v' a = c1" using clock_numbering C2 not0 unfolding v'_def by fastforce
with C C2 have "∃ c ∈ X. v c = a ∧ v' a = c" "a ≤ n" by auto
} note clock_dest_1 = this
{ fix a b assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "b > 0"
from aux1[OF ys(4,4,2) A] have C2: "b ≤ n" by auto
then obtain c2 where C: "v c2 = b" "c2 ∈ X"
using clock_numbering(2) not0 unfolding v'_def by meson
then have "v' b = c2" using clock_numbering C2 not0 unfolding v'_def by fastforce
with C C2 have "∃ c ∈ X. v c = b ∧ v' b = c" "b ≤ n" by auto
} note clock_dest_2 = this
have clock_dest:
"⋀ a b. (a,b) ∈ set (arcs i i ys) ⟹ a > 0 ⟹ b > 0 ⟹
∃ c1 ∈ X. ∃ c2 ∈ X. v c1 = a ∧ v c2 = b ∧ v' a = c1 ∧ v' b = c2 &&& a ≤ n &&& b ≤ n"
using clock_dest_1 clock_dest_2 by (auto) presburger
{ fix a assume A: "(a,0) ∈ set (arcs i i ys)"
assume not0: "a > 0"
assume bounded: "M⇩R a 0 ≠ ∞"
assume lt: "M a 0 < M⇩R a 0"
from clock_dest_1[OF A not0] obtain c1 where C:
"v c1 = a" "c1 ∈ X" "v' a = c1" and C2: "a ≤ n"
by blast
from C2 not0 bounded M⇩R(5) obtain d :: int where *:
"d ≤ int (k (v' a))"
"M⇩R a 0 = Le d ∧ M⇩R 0 a = Le (- d) ∨ M⇩R a 0 = Lt d ∧ M⇩R 0 a = Lt (- d + 1)"
unfolding v'_def by auto
with C have **: "d ≤ int (k c1)" by auto
from *(2) have ?thesis
proof (standard, goal_cases)
case 1
with lt have "M a 0 < Le d" by auto
then have "M a 0 ≤ Lt d" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 < d}"
by auto
from beta_interp.β_boundedness_lt'[OF ** C(2) this] have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 < d}"
.
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) None (M⇩R a 0)" "dbm_entry_val u None (Some c1) (M⇩R 0 a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
then have "u c1 = d" using 1 by auto
then have "u ∉ {u ∈ V. u c1 < d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
next
case 2
from 2 lt have "M a 0 ≠ ∞" by auto
with dbm_entry_int[OF this] M(3) ‹a ≤ n›
obtain d' :: int where d': "M a 0 = Le d' ∨ M a 0 = Lt d'" by auto
then have "M a 0 ≤ Le (d - 1)" using lt 2
apply (auto simp: less_eq dbm_le_def less)
apply (cases rule: dbm_lt.cases)
apply auto
apply rule
apply (cases rule: dbm_lt.cases)
by auto
with lt have "M a 0 ≤ Le (d - 1)" by auto
from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 ≤ d - 1}"
by auto
from beta_interp.β_boundedness_le'[OF _ C(2) this] ** have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 ≤ d - 1}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u None (Some c1) (M⇩R 0 a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
then have "u c1 > d - 1" using 2 by auto
then have "u ∉ {u ∈ V. u c1 ≤ d - 1}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
} note bounded_zero_1 = this
{ fix a assume A: "(0,a) ∈ set (arcs i i ys)"
assume not0: "a > 0"
assume bounded: "M⇩R a 0 ≠ ∞"
assume lt: "M 0 a < M⇩R 0 a"
from clock_dest_2[OF A not0] obtain c1 where C:
"v c1 = a" "c1 ∈ X" "v' a = c1" and C2: "a ≤ n"
by blast
from C2 not0 bounded M⇩R(5) obtain d :: int where *:
"d ≤ int (k (v' a))"
"M⇩R a 0 = Le d ∧ M⇩R 0 a = Le (- d) ∨ M⇩R a 0 = Lt d ∧ M⇩R 0 a = Lt (- d + 1)"
unfolding v'_def by auto
with C have **: "- int (k c1) ≤ - d" by auto
from *(2) have ?thesis
proof (standard, goal_cases)
case 1
with lt have "M 0 a < Le (-d)" by auto
then have "M 0 a ≤ Lt (-d)" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. d < u c1}"
by auto
from beta_interp.β_boundedness_gt'[OF _ C(2) this] ** have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. - u c1 < -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) None (M⇩R a 0)" "dbm_entry_val u None (Some c1) (M⇩R 0 a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with 1 have "u ∉ {u ∈ V. - u c1 < -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
next
case 2
from 2 lt have "M 0 a ≠ ∞" by auto
with dbm_entry_int[OF this] M(3) ‹a ≤ n›
obtain d' :: int where d': "M 0 a = Le d' ∨ M 0 a = Lt d'" by auto
then have "M 0 a ≤ Le (-d)" using lt 2
apply (auto simp: less_eq dbm_le_def less)
apply (cases rule: dbm_lt.cases)
apply auto
apply rule
apply (metis get_const.simps(2) 2 of_int_less_iff of_int_minus zless_add1_eq)
apply (cases rule: dbm_lt.cases)
apply auto
apply (rule dbm_lt.intros(5))
by (simp add: int_lt_Suc_le)
from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. d ≤ u c1}"
by auto
from beta_interp.β_boundedness_ge'[OF _ C(2) this] ** have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. - u c1 ≤ -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) None (M⇩R a 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with 2 have "u ∉ {u ∈ V. - u c1 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
} note bounded_zero_2 = this
{ fix a b c c1 c2 assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "a > 0" "b > 0"
assume lt: "M a b = Lt c"
assume neg: "M a b + M⇩R b a < 𝟭"
assume C: "v c1 = a" "v c2 = b" "c1 ∈ X" "c2 ∈ X" and C2: "a ≤ n" "b ≤ n"
assume valid: "-k c2 ≤ -get_const (M⇩R b a)" "-get_const (M⇩R b a) ≤ k c1"
from neg have "M⇩R b a ≠ ∞" by auto
then obtain d where *: "M⇩R b a = Le d ∨ M⇩R b a = Lt d" by (cases "M⇩R b a", auto)+
with M⇩R(7) ‹_ _ _ ≠ ∞› have "d ∈ ℤ" by fastforce
with * obtain d :: int where *: "M⇩R b a = Le d ∨ M⇩R b a = Lt d" using Ints_cases by auto
with valid have valid: "- k c2 ≤ -d" "-d ≤ k c1" by auto
from * neg lt have "M a b ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 < - d}"
.
from beta_interp.β_boundedness_diag_lt'[OF valid C(3,4) this] have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 - u c2 < -d}"
.
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) (Some c1) (M⇩R b a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with * have "u ∉ {u ∈ V. u c1 - u c2 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note neg_sum_lt = this
{ fix a b assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "a > 0" "b > 0"
assume neg: "M a b + M⇩R b a < 𝟭"
from clock_dest[OF A not0] obtain c1 c2 where
C: "v c1 = a" "v c2 = b" "c1 ∈ X" "c2 ∈ X" and C2: "a ≤ n" "b ≤ n"
by blast
then have C3: "v' a = c1" "v' b = c2" unfolding v'_def using clock_numbering(1) by auto
from neg have inf: "M a b ≠ ∞" "M⇩R b a ≠ ∞" by auto
from M⇩R(8) inf not0 C(3,4) C2 C3 obtain d :: int where d:
"M⇩R b a = Le d ∨ M⇩R b a = Lt d" "- int (k c1) ≤ d" "d ≤ int (k c2)"
unfolding v'_def by auto
from inf obtain c where c: "M a b = Le c ∨ M a b = Lt c" by (cases "M a b") auto
{ assume **: "M a b ≤ Lt (-d)"
from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 < (- d)}"
.
from beta_interp.β_boundedness_diag_lt'[OF _ _ C(3,4) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 - u c2 < -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) (Some c1) (M⇩R b a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. u c1 - u c2 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M a b ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 1
note A = this
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg d have "M a b ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg d have "M a b ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 ≤ - d}"
.
from beta_interp.β_boundedness_diag_le'[OF _ _ C(3,4) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 - u c2 ≤ -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) (Some c1) (M⇩R b a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. u c1 - u c2 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_1 = this
{ fix a b assume A: "(a,0) ∈ set (arcs i i ys)"
assume not0: "a > 0"
assume neg: "M a 0 + M⇩R 0 a < 𝟭"
from clock_dest_1[OF A not0] obtain c1 where C: "v c1 = a" "c1 ∈ X" and C2: "a ≤ n" by blast
with clock_numbering(1) have C3: "v' a = c1" unfolding v'_def by auto
from neg have inf: "M a 0 ≠ ∞" "M⇩R 0 a ≠ ∞" by auto
from M⇩R(6) not0 C2 C3 obtain d :: int where d:
"M⇩R 0 a = Le d ∨ M⇩R 0 a = Lt d" "- int (k c1) ≤ d" "d ≤ 0"
unfolding v'_def by auto
from inf obtain c where c: "M a 0 = Le c ∨ M a 0 = Lt c" by (cases "M a 0") auto
{ assume "M a 0 ≤ Lt (-d)"
from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 < - d}"
.
from beta_interp.β_boundedness_lt'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 < -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u None (Some c1) (M⇩R 0 a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. u c1 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M a 0 ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 1
note A = this
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg d have "M a 0 ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg d have "M a 0 ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 ≤ - d}"
.
from beta_interp.β_boundedness_le'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 ≤ -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u None (Some c1) (M⇩R 0 a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. u c1 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_1' = this
{ fix a b assume A: "(0,b) ∈ set (arcs i i ys)"
assume not0: "b > 0"
assume neg: "M 0 b + M⇩R b 0 < 𝟭"
from clock_dest_2[OF A not0] obtain c2 where
C: "v c2 = b" "c2 ∈ X" and C2: "b ≤ n"
by blast
with clock_numbering(1) have C3: "v' b = c2" unfolding v'_def by auto
from neg have "M 0 b ≠ ∞" "M⇩R b 0 ≠ ∞" by auto
with M⇩R(5) not0 C2 C3 obtain d :: int where d:
"M⇩R b 0 = Le d ∨ M⇩R b 0 = Lt d" "d ≤ k c2"
unfolding v'_def by fastforce
from ‹M 0 b ≠ ∞› obtain c where c: "M 0 b = Le c ∨ M 0 b = Lt c" by (cases "M 0 b") auto
{ assume "M 0 b ≤ Lt (-d)"
from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 > d}"
by simp
from beta_interp.β_boundedness_gt'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. - u c2 < -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) None (M⇩R b 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. - u c2 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M 0 b ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case A: 1
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg have "M 0 b ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg c have "M 0 b ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 ≥ d}"
by simp
from beta_interp.β_boundedness_ge'[OF _ C(2) this] d(2) have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. - u c2 ≤ -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) None (M⇩R b 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. - u c2 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_1'' = this
{ fix a b assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "b > 0" "a > 0"
assume neg: "M⇩R a b + M b a < 𝟭"
from clock_dest[OF A not0(2,1)] obtain c1 c2 where
C: "v c1 = a" "v c2 = b" "c1 ∈ X" "c2 ∈ X" and C2: "a ≤ n" "b ≤ n"
by blast
then have C3: "v' a = c1" "v' b = c2" unfolding v'_def using clock_numbering(1) by auto
from neg have inf: "M b a ≠ ∞" "M⇩R a b ≠ ∞" by auto
with M⇩R(8) not0 C(3,4) C2 C3 obtain d :: int where d:
"M⇩R a b = Le d ∨ M⇩R a b = Lt d" "d ≥ -int (k c2)" "d ≤ int (k c1)"
unfolding v'_def by blast
from inf obtain c where c: "M b a = Le c ∨ M b a = Lt c" by (cases "M b a") auto
{ assume "M b a ≤ Lt (-d)"
from dbm_lt'[OF assms(2)[folded M(1)] this C2(2,1) C(2,1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 - u c1 < - d}"
.
from beta_interp.β_boundedness_diag_lt'[OF _ _ C(4,3) this] d
have "Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c2 - u c1 < -d}" by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) (Some c2) (M⇩R a b)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. u c2 - u c1 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M b a ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case A: 1
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg d have "M b a ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg d have "M b a ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'[OF assms(2)[folded M(1)] this C2(2,1) C(2,1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 - u c1 ≤ - d}"
.
from beta_interp.β_boundedness_diag_le'[OF _ _ C(4,3) this] d
have "Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c2 - u c1 ≤ -d}" by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) (Some c2) (M⇩R a b)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. u c2 - u c1 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_2 = this
{ fix a b assume A: "(a,0) ∈ set (arcs i i ys)"
assume not0: "a > 0"
assume neg: "M⇩R a 0 + M 0 a < 𝟭"
from clock_dest_1[OF A not0] obtain c1 where C: "v c1 = a" "c1 ∈ X" and C2: "a ≤ n" by blast
with clock_numbering(1) have C3: "v' a = c1" unfolding v'_def by auto
from neg have inf: "M 0 a ≠ ∞" "M⇩R a 0 ≠ ∞" by auto
with M⇩R(5) not0 C2 C3 obtain d :: int where d:
"M⇩R a 0 = Le d ∨ M⇩R a 0 = Lt d" "d ≤ int (k c1)" "d ≥ 0"
unfolding v'_def by auto
from inf obtain c where c: "M 0 a = Le c ∨ M 0 a = Lt c" by (cases "M 0 a") auto
{ assume "M 0 a ≤ Lt (-d)"
from dbm_lt'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 > d}"
by simp
from beta_interp.β_boundedness_gt'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 > d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) None (M⇩R a 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. u c1 > d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M 0 a ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case A: 1
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg d have "M 0 a ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg d have "M 0 a ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'3[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 ≥ d}"
by simp
from beta_interp.β_boundedness_ge'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 ≥ d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) None (M⇩R a 0)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. u c1 ≥ d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_2' = this
{ fix a b assume A: "(0,b) ∈ set (arcs i i ys)"
assume not0: "b > 0"
assume neg: "M⇩R 0 b + M b 0 < 𝟭"
from clock_dest_2[OF A not0] obtain c2 where
C: "v c2 = b" "c2 ∈ X" and C2: "b ≤ n"
by blast
with clock_numbering(1) have C3: "v' b = c2" unfolding v'_def by auto
from neg have "M b 0 ≠ ∞" "M⇩R 0 b ≠ ∞" by auto
with M⇩R(6) not0 C2 C3 obtain d :: int where d:
"M⇩R 0 b = Le d ∨ M⇩R 0 b = Lt d" "-d ≤ k c2"
unfolding v'_def by fastforce
from ‹M b 0 ≠ ∞› obtain c where c: "M b 0 = Le c ∨ M b 0 = Lt c" by (cases "M b 0") auto
{ assume "M b 0 ≤ Lt (-d)"
from dbm_lt'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 < - d}"
by simp
from beta_interp.β_boundedness_lt'[OF _ C(2) this] d have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c2 < -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u None (Some c2) (M⇩R 0 b)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with d have "u ∉ {u ∈ V. u c2 < -d}" by auto
}
ultimately have ?thesis using M⇩R(1) M(1) by auto
} note aux = this
from c have ?thesis
proof (standard, goal_cases)
case 2
with neg d have "M b 0 ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 1
note A = this
from d(1) show ?thesis
proof (standard, goal_cases)
case 1
with A neg have "M b 0 ≤ Lt (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
with aux show ?thesis .
next
case 2
with A neg c have "M b 0 ≤ Le (-d)" unfolding less_eq dbm_le_def mult neutral less
by (auto elim!: dbm_lt.cases)
from dbm_le'2[OF assms(2)[folded M(1)] this C2 C(1) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c2 ≤ - d}"
by simp
from beta_interp.β_boundedness_le'[OF _ C(2) this] d(2) have
"Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c2 ≤ -d}"
by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u None (Some c2) (M⇩R 0 b)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with A 2 have "u ∉ {u ∈ V. u c2 ≤ -d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
qed
} note neg_sum_2'' = this
{ fix a b assume A: "(a,b) ∈ set (arcs i i ys)"
assume not0: "a > 0" "b > 0"
assume bounded: "M⇩R a 0 ≠ ∞" "M⇩R b 0 ≠ ∞"
assume lt: "M a b < M⇩R a b"
from clock_dest[OF A not0] obtain c1 c2 where
C: "v c1 = a" "v c2 = b" "c1 ∈ X" "c2 ∈ X" and C2: "a ≤ n" "b ≤ n"
by blast
from C C2 clock_numbering(1,3) have C3: "v' b = c2" "v' a = c1" unfolding v'_def by blast+
with C C2 not0 bounded M⇩R(4) obtain d :: int where *:
"- int (k c2) ≤ d ∧ d ≤ int (k c1) ∧ M⇩R a b = Le d ∧ M⇩R b a = Le (- d)
∨ - int (k c2) ≤ d - 1 ∧ d ≤ int (k c1) ∧ M⇩R a b = Lt d ∧ M⇩R b a = Lt (- d + 1)"
unfolding v'_def by force
from * have ?thesis
proof (standard, goal_cases)
case 1
with lt have "M a b < Le d" by auto
then have "M a b ≤ Lt d" unfolding less less_eq dbm_le_def by (fastforce elim!: dbm_lt.cases)
from dbm_lt'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 < d}"
.
from beta_interp.β_boundedness_diag_lt'[OF _ _ C(3,4) this] 1
have "Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 - u c2 < d}" by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c1) (Some c2) (M⇩R a b)" "dbm_entry_val u (Some c2) (Some c1) (M⇩R b a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with 1 have "u ∉ {u ∈ V. u c1 - u c2 < d}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
next
case 2
with lt have "M a b ≠ ∞" by auto
with dbm_entry_int[OF this] M(3) ‹a ≤ n› ‹b ≤ n›
obtain d' :: int where d': "M a b = Le d' ∨ M a b = Lt d'" by auto
then have "M a b ≤ Le (d - 1)" using lt 2
apply (auto simp: less_eq dbm_le_def less)
apply (cases rule: dbm_lt.cases)
apply auto
apply (rule dbm_lt.intros)
apply (cases rule: dbm_lt.cases)
by auto
with lt have "M a b ≤ Le (d - 1)" by auto
from dbm_le'[OF assms(2)[folded M(1)] this C2 C(1,2) not0] have
"[M]⇘v,n⇙ ⊆ {u ∈ V. u c1 - u c2 ≤ d - 1}"
.
from beta_interp.β_boundedness_diag_le'[OF _ _ C(3,4) this] 2
have "Approx⇩β ([M]⇘v,n⇙) ⊆ {u ∈ V. u c1 - u c2 ≤ d - 1}" by auto
moreover
{ fix u assume u: "u ∈ [M⇩R]⇘v,n⇙"
with C C2 have
"dbm_entry_val u (Some c2) (Some c1) (M⇩R b a)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with 2 have "u ∉ {u ∈ V. u c1 - u c2 ≤ d - 1}" by auto
}
ultimately show ?thesis using M⇩R(1) M(1) by auto
qed
} note bounded = this
{ assume not_bounded: "∀ (a,b) ∈ set (arcs i i ys). M a b < M⇩R a b ⟶ M⇩R a 0 = ∞ ∨ M⇩R b 0 = ∞"
have "∃ y z zs. set zs ∪ {0, y, z} = set (i # ys) ∧ len ?M 0 0 (y # z # zs) < Le 0 ∧
(∀ (a,b) ∈ set (arcs 0 0 (y # z # zs)). M a b < M⇩R a b ⟶ a = y ∧ b = z)
∧ M y z < M⇩R y z ∧ distinct (0 # y # z # zs) ∨ ?thesis"
proof (cases ys)
case Nil
show ?thesis
proof (cases "M i i < M⇩R i i")
case True
then have "?M i i = M i i" by (simp add: min.strict_order_iff)
with Nil ys(1) xs(3) have *: "M i i < 𝟭" by simp
with neg_cycle_empty[OF cn_weak _ ‹i ≤ n›, of "[]" M] have "[M]⇘v,n⇙ = {}" by auto
with ‹Z ≠ {}› M(1) show ?thesis by auto
next
case False
then have "?M i i = M⇩R i i" by (simp add: min_absorb2)
with Nil ys(1) xs(3) have "M⇩R i i < 𝟭" by simp
with neg_cycle_empty[OF cn_weak _ ‹i ≤ n›, of "[]" M⇩R] have "[M⇩R]⇘v,n⇙ = {}" by auto
with ‹R ≠ {}› M⇩R(1) show ?thesis by auto
qed
next
case (Cons w ws)
note ws = this
show ?thesis
proof (cases ws)
case Nil
with ws ys xs(3) have *:
"?M i w + ?M w i < 𝟭" "?M w i = M w i ⟶ ?M i w ≠ M i w" "(i, w) ∈ set (arcs i i ys)"
by auto
have "R ∩ Approx⇩β Z = {}"
proof (cases "?M w i = M w i")
case True
with *(2) have "?M i w = M⇩R i w" unfolding min_def by auto
with *(1) True have neg: "M⇩R i w + M w i < 𝟭" by auto
show ?thesis
proof (cases "i = 0")
case True
show ?thesis
proof (cases "w = 0")
case True with 0 ‹i = 0› *(3) show ?thesis by auto
next
case False with ‹i = 0› neg_sum_2'' *(3) neg show ?thesis by blast
qed
next
case False
show ?thesis
proof (cases "w = 0")
case True with ‹i ≠ 0› neg_sum_2' *(3) neg show ?thesis by blast
next
case False with ‹i ≠ 0› neg_sum_2 *(3) neg show ?thesis by blast
qed
qed
next
case False
have "M⇩R w i < M w i"
proof (rule ccontr, goal_cases)
case 1
then have "M⇩R w i ≥ M w i" by auto
with False show False unfolding min_def by auto
qed
with one_M ws Nil have "M i w < M⇩R i w" by auto
then have "?M i w = M i w" unfolding min_def by auto
moreover from False *(2) have "?M w i = M⇩R w i" unfolding min_def by auto
ultimately have neg: "M i w + M⇩R w i < 𝟭" using *(1) by auto
show ?thesis
proof (cases "i = 0")
case True
show ?thesis
proof (cases "w = 0")
case True with 0 ‹i = 0› *(3) show ?thesis by auto
next
case False with ‹i = 0› neg_sum_1'' *(3) neg show ?thesis by blast
qed
next
case False
show ?thesis
proof (cases "w = 0")
case True with ‹i ≠ 0› neg_sum_1' *(3) neg show ?thesis by blast
next
case False with ‹i ≠ 0› neg_sum_1 *(3) neg show ?thesis by blast
qed
qed
qed
then show ?thesis by simp
next
case zs: (Cons z zs)
from one_M obtain a b where *:
"(a,b) ∈ set (arcs i i ys)" "M a b < M⇩R a b"
by fastforce
from cycle_rotate_3'[OF _ *(1) ys(3)] ws cycle_closes obtain ws' where ws':
"len ?M i i ys = len ?M a a (b # ws')" "set (a # b # ws') = set (i # ys)"
"1 + length ws' = length ys" "set (arcs i i ys) = set (arcs a a (b # ws'))"
and successive: "successive (λ(a, b). ?M a b = M a b) (arcs a a (b # ws') @ [(a, b)])"
by blast
from successive have successive_arcs:
"successive (λ(a, b). ?M a b = M a b) (arcs a b (b # ws' @ [a]))"
using arcs_decomp_tail by auto
from ws'(4) one_M_R *(2) obtain c d where **:
"(c,d) ∈ set (arcs a a (b # ws'))" "M c d > M⇩R c d" "(a,b) ≠ (c,d)"
by fastforce
from card_distinct[of "a # b # ws'"] distinct_card[of "i # ys"] ws'(2,3) distinct
have distinct: "distinct (a # b # ws')" by simp
from ws zs ws'(3) have "ws' ≠ []" by auto
then obtain z zs where z: "ws' = zs @ [z]" by (metis append_butlast_last_id)
then have "b # ws' = (b # zs) @ [z]" by simp
with len_decomp[OF this, of ?M a a] arcs_decomp_tail have rotated:
"len ?M a a (b # ws') = len ?M z z (a # b # zs)"
"set (arcs a a (b # ws')) = set (arcs z z (a # b # zs))"
by (auto simp add: comm)
from ys(1) xs(3) ws'(1) have "len ?M a a (b # ws') < 𝟭" by auto
from ws'(2) ys(2) ‹i ≤ n› z have n_bounds: "a ≤ n" "b ≤ n" "set ws' ⊆ {0..n}" "z ≤ n" by auto
from * have a_b: "?M a b = M a b" by (simp add: min.strict_order_iff)
from successive successive_split[of _ "arcs a z (b # zs)" "[(z,a), (a,b)]"]
have first: "successive (λ(a, b). ?M a b = M a b) (arcs a z (b # zs))" and
last_two: "successive (λ(a, b). ?M a b = M a b) [(z, a), (a, b)]"
using arcs_decomp_tail z by auto
from * not_bounded have not_bounded': "M⇩R a 0 = ∞ ∨ M⇩R b 0 = ∞" by auto
from this(1) have "z = 0"
proof
assume inf: "M⇩R b 0 = ∞"
from a_b successive obtain z where z: "(b,z) ∈ set (arcs b a ws')" "?M b z ≠ M b z"
by (cases ws') auto
then have "?M b z = M⇩R b z" by (meson min_def)
from arcs_distinct2[OF _ _ _ _ z(1)] distinct have "b ≠ z" by auto
from z n_bounds have "z ≤ n"
apply (induction ws' arbitrary: b)
apply auto[]
apply (rename_tac ws' b)
apply (case_tac ws')
apply auto
done
have "M⇩R b z = ∞"
proof (cases "z = 0")
case True
with inf show ?thesis by auto
next
case False
with inf M⇩R(2) ‹b ≠ z› ‹z ≤ n› ‹b ≤ n› show ?thesis by blast
qed
with ‹?M b z = M⇩R b z› have "len ?M b a ws' = ∞" by (auto intro: len_inf_elem[OF z(1)])
then have "∞ = len ?M a a (b # ws')" by simp
with ‹len ?M a a _ < 𝟭› show ?thesis by auto
next
assume inf: "M⇩R a 0 = ∞"
show "z = 0"
proof (rule ccontr)
assume "z ≠ 0"
with last_two a_b have "?M z a = M⇩R z a" by (auto simp: min_def)
from distinct z have "a ≠ z" by auto
with ‹z ≠ 0› ‹a ≤ n› ‹z ≤ n› M⇩R(2) inf have "M⇩R z a = ∞" by blast
with ‹?M z a = M⇩R z a› have "len ?M z z (a # b # zs) = ∞" by (auto intro: len_inf_elem)
with ‹len ?M a a _ < 𝟭› rotated show False by auto
qed
qed
{ fix c d assume A: "(c, d) ∈ set (arcs 0 0 (a # b # zs))" "M c d < M⇩R c d"
then have *: "?M c d = M c d" by (simp add: min.strict_order_iff)
from rotated(2) A ‹z = 0› not_bounded ws'(4) have **: "M⇩R c 0 = ∞ ∨ M⇩R d 0 = ∞" by auto
{ assume inf: "M⇩R c 0 = ∞"
fix x assume x: "(x, c) ∈ set (arcs a 0 (b # zs))" "?M x c ≠ M x c"
from x(2) have "?M x c = M⇩R x c" unfolding min_def by auto
from arcs_elem[OF x(1)] z ‹z = 0› have
"x ∈ set (a # b # ws')" "c ∈ set (a # b # ws')"
by auto
with n_bounds have "x ≤ n" "c ≤ n" by auto
have "x = 0"
proof (rule ccontr)
assume "x ≠ 0"
from distinct z arcs_distinct1[OF _ _ _ _ x(1)] ‹z = 0›have "x ≠ c" by auto
with ‹x ≠ 0› ‹c ≤ n› ‹x ≤ n› M⇩R(2) inf have "M⇩R x c = ∞" by blast
with ‹?M x c = M⇩R x c› have
"len ?M a 0 (b # zs) = ∞"
by (fastforce intro: len_inf_elem[OF x(1)])
with ‹z = 0› have "len ?M z z (a # b # zs) = ∞" by auto
with ‹len ?M a a _ < 𝟭› rotated show False by auto
qed
with arcs_distinct_dest1[OF _ x(1), of z] z distinct x ‹z = 0› have False by auto
} note c_0_inf = this
have "a = c ∧ b = d"
proof (cases "(c, d) = (0, a)")
case True
with last_two ‹z = 0› * a_b have False by auto
then show ?thesis by simp
next
case False
show ?thesis
proof (rule ccontr, goal_cases)
case 1
with False A(1) have ***: "(c, d) ∈ set (arcs b 0 zs)" by auto
from successive z ‹z = 0› have
"successive (λ(a, b). ?M a b = M a b) ([(a, b)] @ arcs b 0 zs @ [(0, a), (a, b)])"
by (simp add: arcs_decomp)
then have ****: "successive (λ(a, b). ?M a b = M a b) (arcs b 0 zs)"
using successive_split[of _ "[(a, b)]" "arcs b 0 zs @ [(0, a), (a, b)]"]
successive_split[of _ "arcs b 0 zs" "[(0, a), (a, b)]"]
by auto
from successive_predecessor[OF *** _ this] successive z
obtain x where x: "(x, c) ∈ set (arcs a 0 (b # zs))" "?M x c ≠ M x c"
proof (cases "c = b")
case False
then have "zs ≠ []" using *** by auto
from successive_predecessor[OF *** False **** _ this] * obtain x where x:
"(zs = [c] ∧ x = b ∨ (∃ys. zs = c # d # ys ∧ x = b)
∨ (∃ys. zs = ys @ [x, c] ∧ d = 0) ∨ (∃ys ws. zs = ys @ x # c # d # ws))"
"?M x c ≠ M x c"
by blast+
from this(1) have "(x, c) ∈ set (arcs a 0 (b # zs))" using arcs_decomp by auto
with x(2) show ?thesis by (auto intro: that)
next
case True
have ****: "successive (λ(a, b). ?M a b = M a b) (arcs a 0 (b # zs))"
using first ‹z = 0› arcs_decomp successive_arcs z by auto
show ?thesis
proof (cases zs)
case Nil
with **** True *** * show ?thesis by (auto intro: that)
next
case (Cons u us)
with *** True distinct z ‹z = 0› have "distinct (b # u # us @ [0])" by auto
from arcs_distinct_fix[OF this] *** True Cons have "d = u" by auto
with **** * Cons True show ?thesis by (auto intro: that)
qed
qed
show False
proof (cases "d = 0")
case True
from ** show False
proof
assume "M⇩R c 0 = ∞" from c_0_inf[OF this x] show False .
next
assume "M⇩R d 0 = ∞" with ‹d = 0› M⇩R(3) show False by auto
qed
next
case False with *** have "zs ≠ []" by auto
from successive_successor[OF ‹(c,d) ∈ set (arcs b 0 zs)› False **** _ this] *
obtain e where
"(zs = [d] ∧ e = 0 ∨ (∃ys. zs = d # e # ys) ∨ (∃ys. zs = ys @ [c, d] ∧ e = 0)
∨ (∃ys ws. zs = ys @ c # d # e # ws))" "?M d e ≠ M d e"
by blast
then have e: "(d, e) ∈ set (arcs b 0 zs)" "?M d e ≠ M d e" using arcs_decomp by auto
from ** show False
proof
assume inf: "M⇩R d 0 = ∞"
from e have "?M d e = M⇩R d e" by (meson min_def)
from arcs_distinct2[OF _ _ _ _ e(1)] z ‹z = 0› distinct have "d ≠ e" by auto
from z n_bounds have "set zs ⊆ {0..n}" by auto
with e have "e ≤ n"
apply (induction zs arbitrary: d)
apply auto
apply (case_tac zs)
apply auto
done
from n_bounds z arcs_elem(2)[OF A(1)] have "d ≤ n" by auto
have "M⇩R d e = ∞"
proof (cases "e = 0")
case True
with inf show ?thesis by auto
next
case False
with inf M⇩R(2) ‹d ≠ e› ‹e ≤ n› ‹d ≤ n› show ?thesis by blast
qed
with ‹?M d e = M⇩R d e› have "len ?M b 0 zs = ∞" by (auto intro: len_inf_elem[OF e(1)])
with ‹z = 0› rotated have "∞ = len ?M a a (b # ws')" by simp
with ‹len ?M a a _ < 𝟭› show ?thesis by auto
next
assume "M⇩R c 0 = ∞" from c_0_inf[OF this x] show False .
qed
qed
qed
qed
}
then have "∀(c, d)∈set (arcs 0 0 (a # b # zs)). M c d < M⇩R c d ⟶ c = a ∧ d = b"
by blast
moreover from ys(1) xs(3) have "len ?M i i ys < Le 0" unfolding neutral by auto
moreover with rotated ws'(1) have "len ?M z z (a # b # zs) < Le 0" by auto
moreover from ‹z = 0› z ws'(2) have "set zs ∪ {0, a, b} = set (i # ys)" by auto
moreover from ‹z = 0› distinct z have "distinct (0 # a # b # zs)" by auto
ultimately show ?thesis using ‹z = 0› ‹M a b < M⇩R a b› by blast
qed
qed note * = this
{ assume "¬ ?thesis"
with * obtain y z zs where *:
"set zs ∪ {0, y, z} = set (i # ys)" "len ?M 0 0 (y # z # zs) < Le 0"
"∀(a, b)∈set (arcs 0 0 (y # z # zs)). M a b < M⇩R a b ⟶ a = y ∧ b = z" "M y z < M⇩R y z"
and distinct': "distinct (0 # y # z # zs)"
by blast
then have "y ≠ 0" "z ≠ 0" by auto
let ?r = "len M⇩R z 0 zs"
have "∀(a, b)∈set (arcs z 0 zs). ?M a b = M⇩R a b"
proof (safe, goal_cases)
case A: (1 a b)
have "M⇩R a b ≤ M a b"
proof (rule ccontr, goal_cases)
case 1
with *(3) A have "a = y" "b = z" by auto
with A distinct' arcs_distinct3[OF _ A, of y] show False by auto
qed
then show ?case by (simp add: min_def)
qed
then have r: "len ?M z 0 zs = ?r" by (induction zs arbitrary: z) auto
with *(2) have **: "?M 0 y + (?M y z + ?r) < Le 0" by simp
from M⇩R(1) ‹R ≠ {}› obtain u where u: "DBM_val_bounded v u M⇩R n"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
from *(1) ‹i ≤ n› ‹set ys ⊆ _› have "y ≤ n" "z ≤ n" by fastforce+
from *(1) ys(2,4) have "set zs ⊆ {0 ..n}" by auto
from ‹y ≤ n› ‹z ≤ n› clock_numbering(2) ‹y ≠ 0› ‹z ≠ 0› obtain c1 c2 where C:
"c1 ∈ X" "c2 ∈ X" "v c1 = y" "v c2 = z"
by blast+
with clock_numbering(1,3) have C2: "v' y = c1" "v' z = c2" unfolding v'_def by auto
with C have "v (v' z) = z" by auto
with DBM_val_bounded_len'1[OF u, of zs "v' z"] have "dbm_entry_val u (Some (v' z)) None ?r"
using ‹z ≤ n› clock_numbering(2) ‹set zs ⊆ _› distinct' by force
from len_inf_elem ** have tl_not_inf: "∀(a, b)∈set (arcs z 0 zs). M⇩R a b ≠ ∞" by fastforce
with M⇩R(7) len_int_dbm_closed have "get_const ?r ∈ ℤ ∧ ?r ≠ ∞" by blast
then obtain r :: int where r': "?r = Le r ∨ ?r = Lt r" using Ints_cases by (cases ?r) auto
from r' ‹dbm_entry_val _ _ _ _› C C2 have le: "u (v' z) ≤ r" by fastforce
from arcs_ex_head obtain z' where "(z, z') ∈ set (arcs z 0 zs)" by blast
then have z':
"(z, z') ∈ set (arcs 0 0 (y # z # zs))" "(z, z') ∈ set (arcs z 0 zs)"
by auto
have "M⇩R z 0 ≠ ∞"
proof (rule ccontr, goal_cases)
case 1
then have inf: "M⇩R z 0 = ∞" by auto
have "M⇩R z z' = ∞"
proof (cases "z' = 0")
case True
with 1 show ?thesis by auto
next
case False
from arcs_elem[OF z'(1)] *(1) ‹i ≤ n› ‹set ys ⊆ _› have "z' ≤ n" by fastforce
moreover from distinct' *(1) arcs_distinct1[OF _ _ _ _ z'(1)] have "z ≠ z'" by auto
ultimately show ?thesis using M⇩R(2) ‹z ≤ n› False inf by blast
qed
with tl_not_inf z'(2) show False by auto
qed
with M⇩R(5) ‹z ≠ 0› ‹z ≤ n› obtain d :: int where d:
"M⇩R z 0 = Le d ∧ M⇩R 0 z = Le (-d) ∨ M⇩R z 0 = Lt d ∧ M⇩R 0 z = Lt (-d + 1)"
"d ≤ k (v' z)" "0 ≤ d"
unfolding v'_def by auto
text ‹Needs property that len of integral dbm entries is integral and definition of ‹M_R››
from this (1) have rr: "?r ≥ M⇩R z 0"
proof (standard, goal_cases)
case A: 1
with u ‹z ≤ n› C C2 have *: "- u (v' z) ≤ -d" unfolding DBM_val_bounded_def by fastforce
from r' show ?case
proof (standard, goal_cases)
case 1
with le * A show ?case unfolding less_eq dbm_le_def by fastforce
next
case 2
with ‹dbm_entry_val _ _ _ _› C C2 have "u (v' z) < r" by fastforce
with * have "r > d" by auto
with A 2 show ?case unfolding less_eq dbm_le_def by fastforce
qed
next
case A: 2
with u ‹z ≤ n› C C2 have *: "- u (v' z) < -d + 1" unfolding DBM_val_bounded_def by fastforce
from r' show ?case
proof (standard, goal_cases)
case 1
with le * A show ?case unfolding less_eq dbm_le_def by fastforce
next
case 2
with ‹dbm_entry_val _ _ _ _› C C2 have "u (v' z) ≤ r" by fastforce
with * have "r ≥ d" by auto
with A 2 show ?case unfolding less_eq dbm_le_def by fastforce
qed
qed
with *(3) ‹y ≠ 0› have "M 0 y ≥ M⇩R 0 y" by fastforce
then have "?M 0 y = M⇩R 0 y" by (simp add: min.absorb2)
moreover from *(4) have "?M y z = M y z" unfolding min_def by auto
ultimately have **: "M⇩R 0 y + (M y z + M⇩R z 0) < Le 0"
using ** add_mono_right[OF add_mono_right[OF rr], of "M⇩R 0 y" "M y z"] by simp
from ** have not_inf: "M⇩R 0 y ≠ ∞" "M y z ≠ ∞" "M⇩R z 0 ≠ ∞" by auto
from M⇩R(6) ‹y ≠ 0› ‹y ≤ n› obtain c :: int where c:
"M⇩R 0 y = Le c ∨ M⇩R 0 y = Lt c" "- k (v' y) ≤ c" "c ≤ 0"
unfolding v'_def by auto
have ?thesis
proof (cases "M⇩R 0 y + M⇩R z 0 = Lt (c + d)")
case True
from ** have "(M⇩R 0 y + M⇩R z 0) + M y z < Le 0" using comm assoc by metis
with True have **: "Lt (c + d) + M y z < Le 0" by simp
then have "M y z ≤ Le (- (c + d))" unfolding less less_eq dbm_le_def mult
by (cases "M y z") (fastforce elim!: dbm_lt.cases)+
from dbm_le'[OF assms(2)[folded M(1)] this ‹y ≤ n› ‹z ≤ n› C(3,4)] ‹y ≠ 0› ‹z ≠ 0› M
have subs: "Z ⊆ {u ∈ V. u c1 - u c2 ≤ - (c + d)}" by blast
with c d have "- k (v' z) ≤ - (c + d)" "- (c + d) ≤ k (v' y)" by auto
with beta_interp.β_boundedness_diag_le'[OF _ _ C(1,2) subs] C2 have
"Approx⇩β Z ⊆ {u ∈ V. u c1 - u c2 ≤ - (c + d)}"
by auto
moreover
{ fix u assume u: "u ∈ R"
with C ‹y ≤ n› ‹z ≤ n› M⇩R(1) have
"dbm_entry_val u (Some c2) None (M⇩R z 0)" "dbm_entry_val u None (Some c1) (M⇩R 0 y)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with True c d(1) have "u ∉ {u ∈ V. u c1 - u c2 ≤ - (c + d)}" unfolding mult by auto
}
ultimately show ?thesis by blast
next
case False
with c d have "M⇩R 0 y + M⇩R z 0 = Le (c + d)" unfolding mult by fastforce
moreover from ** have "(M⇩R 0 y + M⇩R z 0) + M y z < Le 0" using comm assoc by metis
ultimately have **: "Le (c + d) + M y z < Le 0" by simp
then have "M y z ≤ Lt (- (c + d))" unfolding less less_eq dbm_le_def mult
by (cases "M y z") (fastforce elim!: dbm_lt.cases)+
from dbm_lt'[OF assms(2)[folded M(1)] this ‹y ≤ n› ‹z ≤ n› C(3,4)] ‹y ≠ 0› ‹z ≠ 0› M
have subs: "Z ⊆ {u ∈ V. u c1 - u c2 < - (c + d)}" by auto
from c d(2-) C2 have "- k c2 ≤ - (c + d)" "- (c + d) ≤ k c1" by auto
from beta_interp.β_boundedness_diag_lt'[OF this C(1,2) subs] have
"Approx⇩β Z ⊆ {u ∈ V. u c1 - u c2 < - (c + d)}"
.
moreover
{ fix u assume u: "u ∈ R"
with C ‹y ≤ n› ‹z ≤ n› M⇩R(1) have
"dbm_entry_val u (Some c2) None (M⇩R z 0)" "dbm_entry_val u None (Some c1) (M⇩R 0 y)"
unfolding DBM_zone_repr_def DBM_val_bounded_def by auto
with c d(1) have "u ∉ {u ∈ V. u c1 - u c2 < - (c + d)}" by auto
}
ultimately show ?thesis by auto
qed
} then have ?thesis by auto
}
with bounded 0 bounded_zero_1 bounded_zero_2 show ?thesis by blast
qed
qed
qed
section ‹Nice Corollaries of Bouyer's Theorem›
lemma ℛ_V: "⋃ ℛ = V" unfolding V_def ℛ_def using region_cover[of X _ k] by auto
lemma regions_beta_V: "R ∈ ℛ⇩β ⟹ R ⊆ V" unfolding V_def ℛ⇩β_def by auto
lemma apx_V: "Z ⊆ V ⟹ Approx⇩β Z ⊆ V"
proof (goal_cases)
case 1
from beta_interp.apx_in[OF 1] obtain U where "Approx⇩β Z = ⋃U" "U ⊆ ℛ⇩β" by auto
with regions_beta_V show ?thesis by auto
qed
corollary approx_β_closure_α:
assumes "Z ⊆ V" "vabstr Z M"
shows "Approx⇩β Z ⊆ Closure⇩α Z"
proof -
note T = region_zone_intersect_empty_approx_correct[OF _ assms(1) _ assms(2-)]
have "- ⋃{R ∈ ℛ. R ∩ Z ≠ {}} = ⋃{R ∈ ℛ. R ∩ Z = {}} ∪ - V"
proof (safe, goal_cases)
case 1 with ℛ_V show False by fast
next
case 2 then show ?case using alpha_interp.valid_regions_distinct_spec by fastforce
next
case 3 then show ?case using ℛ_V unfolding V_def by blast
qed
with T apx_V[OF assms(1)] have "Approx⇩β Z ∩ - ⋃{R ∈ ℛ. R ∩ Z ≠ {}} = {}" by auto
then show ?thesis unfolding alpha_interp.cla_def by blast
qed
definition "V' ≡ {Z. Z ⊆ V ∧ (∃ M. vabstr Z M)}"
corollary approx_β_closure_α': "Z ∈ V' ⟹ Approx⇩β Z ⊆ Closure⇩α Z"
using approx_β_closure_α unfolding V'_def by auto
text ‹We could prove this more directly too (without using ‹Closure⇩α Z›), obviously›
lemma apx_empty_iff:
assumes "Z ⊆ V" "vabstr Z M"
shows "Z = {} ⟷ Approx⇩β Z = {}"
using alpha_interp.cla_empty_iff[OF assms(1)] approx_β_closure_α[OF assms] beta_interp.apx_subset
by auto
lemma apx_empty_iff':
assumes "Z ∈ V'" shows "Z = {} ⟷ Approx⇩β Z = {}"
using apx_empty_iff assms unfolding V'_def by force
lemma apx_V':
assumes "Z ⊆ V" shows "Approx⇩β Z ∈ V'"
proof (cases "Z = {}")
case True
with beta_interp.apx_empty beta_interp.empty_zone_dbm show ?thesis unfolding V'_def neutral by auto
next
case False
then have non_empty: "Approx⇩β Z ≠ {}" using beta_interp.apx_subset by blast
from beta_interp.apx_in[OF assms] obtain U M where *:
"Approx⇩β Z = ⋃U" "U ⊆ ℛ⇩β" "Z ⊆ Approx⇩β Z" "vabstr (Approx⇩β Z) M"
by blast
moreover from * beta_interp.ℛ_union have "⋃ U ⊆ V" by blast
ultimately show ?thesis using *(1,4) unfolding V'_def by auto
qed
section ‹A New Zone Semantics Abstracting with ‹Approx⇩β››
lemma step_z_V':
assumes "A ⊢ ⟨l,Z⟩ ↝ ⟨l',Z'⟩" "valid_abstraction A X k" "∀c∈clk_set A. v c ≤ n" "Z ∈ V'"
shows "Z' ∈ V'"
proof -
from assms(3) clock_numbering have numbering: "global_clock_numbering A v n" by metis
from assms(4) obtain M where M:
"Z ⊆ V" "Z = [M]⇘v,n⇙" "dbm_int M n"
unfolding V'_def by auto
from alpha_interp.step_z_V[OF assms(1) M(1)] M(2) assms(1) step_z_dbm_DBM[OF _ numbering]
step_z_dbm_preserves_int[OF _ numbering assms(2) M(3)]
obtain M' where M': "Z' ⊆ V" "Z' = [M']⇘v,n⇙" "dbm_int M' n" by metis
then show ?thesis unfolding V'_def by blast
qed
lemma steps_z_V':
"A ⊢ ⟨l,Z⟩ ↝* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V' ⟹ Z' ∈ V'"
by (induction rule: steps_z.induct) (auto intro: step_z_V')
subsection ‹Single Step›
inductive step_z_beta ::
"('a, 'c, t, 's) ta ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇩β ⟨_, _⟩" [61,61,61] 61)
where
step_beta: "A ⊢ ⟨l, Z⟩ ↝ ⟨l', Z'⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Approx⇩β Z'⟩"
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ ↝⇩β ⟨l',u'⟩"
declare step_z_beta.intros[intro]
lemma step_z_alpha_sound:
"A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V' ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z''⟩ ∧ Z'' ≠ {}"
apply (induction rule: step_z_beta.induct)
apply (frule step_z_V')
apply assumption+
apply (rotate_tac 4)
apply (drule apx_empty_iff')
by blast
lemma step_z_alpha_complete:
"A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V' ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Z''⟩ ∧ Z'' ≠ {}"
apply (frule step_z_V')
apply assumption+
apply (rotate_tac 4)
apply (drule apx_empty_iff')
by blast
subsection ‹Multi step›
inductive
steps_z_beta :: "('a, 'c, t, 's) ta ⇒ 's ⇒ ('c, t) zone ⇒ 's ⇒ ('c, t) zone ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇩β* ⟨_, _⟩" [61,61,61] 61)
where
refl: "A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l, Z⟩" |
step: "A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝⇩β ⟨l'', Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l'', Z''⟩"
declare steps_z_beta.intros[intro]
lemma V'_V: "Z ∈ V' ⟹ Z ⊆ V" unfolding V'_def by auto
lemma steps_z_beta_V':
"A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ valid_abstraction A X k ⟹∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V' ⟹ Z' ∈ V'"
proof (induction rule: steps_z_beta.induct)
case refl then show ?case by fast
next
case (step A l Z l' Z' l'' Z'')
from this(2) obtain Z''' where Z''': "A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z'''⟩" "Z'' = Approx⇩β Z'''" by auto
from step_z_V'[OF this(1)] step have "Z''' ∈ V'" by auto
from apx_V'[OF V'_V, OF this] Z'''(2) show ?case by auto
qed
lemma alpha_beta_step:
"A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V'
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩α ⟨l', Z''⟩ ∧ Z' ⊆ Z''"
apply (induction rule: step_z_beta.induct)
apply (frule step_z_V')
apply assumption+
apply (rotate_tac 4)
apply (drule approx_β_closure_α')
apply auto
done
subsubsection ‹Soundness›
lemma alpha_beta_step':
"A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V' ⟹ W ⊆ V
⟹ Z ⊆ W ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝⇩α ⟨l', W'⟩ ∧ Z' ⊆ W'"
proof (induction rule: step_z_beta.induct)
case (step_beta A l Z l' Z')
from alpha_interp.step_z_mono[OF step_beta(1,6)] obtain W' where W':
"A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩" "Z' ⊆ W'"
by blast
from approx_β_closure_α'[OF step_z_V'[OF step_beta(1-4)]]
alpha_interp.cla_mono[OF this(2)] this(1)
show ?case by auto
qed
lemma alpha_beta_steps:
"A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ valid_abstraction A X k ⟹ ∀c∈clk_set A. v c ≤ n ⟹ Z ∈ V'
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l', Z''⟩ ∧ Z' ⊆ Z''"
proof (induction rule: steps_z_beta.induct)
case refl then show ?case by auto
next
case (step A l Z l' Z' l'' Z'')
then obtain Z''' where *: "A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'''⟩" "Z' ⊆ Z'''" by auto
from alpha_beta_step'[OF step.hyps(2) step.prems(1,2) steps_z_beta_V'[OF step.hyps(1) step.prems]
alpha_interp.steps_z_alpha_V[OF this(1) V'_V] this(2)] step.prems
obtain W' where "A ⊢ ⟨l', Z'''⟩ ↝⇩α ⟨l'',W'⟩" "Z'' ⊆ W'" by blast
with * show ?case by auto
qed
corollary steps_z_beta_sound:
"A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ ∀c∈clk_set A. v c ≤ n ⟹ valid_abstraction A X k ⟹ Z ∈ V' ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝* ⟨l', Z''⟩ ∧ Z'' ≠ {}"
proof (goal_cases)
case 1
then have "Z ⊆ V" unfolding V'_def by auto
from alpha_beta_steps[OF 1(1,3,2,4)] obtain Z''' where *:
"A ⊢ ⟨l, Z⟩ ↝⇩α* ⟨l',Z'''⟩" "Z' ⊆ Z'''"
by blast
from alpha_interp.steps_z_alpha_closure_involutive[OF *(1) 1(3) ‹Z ⊆ V›] obtain Z'' where
Z'': "A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z''⟩" "Closure⇩α Z''' ⊆ Closure⇩α Z''" "Z'' ⊆ Z'''"
by blast
with alpha_interp.closure_subs[OF alpha_interp.steps_z_alpha_V[OF *(1) ‹Z ⊆ V›]] 1(5)
alpha_interp.cla_empty_iff[OF alpha_interp.steps_z_V, OF this(1) ‹Z ⊆ V›] *(2)
have "Z'' ≠ {}" by auto
with Z'' show ?thesis by auto
qed
subsubsection ‹Completeness›
lemma apx_mono:
"Z' ⊆ V ⟹ Z ⊆ Z' ⟹ Approx⇩β Z ⊆ Approx⇩β Z'"
proof (goal_cases)
case 1
with beta_interp.apx_in have
"Approx⇩β Z' ∈ {S. ∃U M. S = ⋃U ∧ U ⊆ ℛ⇩β ∧ Z' ⊆ S ∧ beta_interp.vabstr S M
∧ beta_interp.normalized M}"
by auto
with 1 obtain U M where
"Approx⇩β Z' = ⋃U" "U ⊆ ℛ⇩β" "Z ⊆ Approx⇩β Z'" "beta_interp.vabstr (Approx⇩β Z') M"
"beta_interp.normalized M"
by auto
with beta_interp.apx_min show ?thesis by auto
qed
lemma step_z_beta_mono:
"A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Z'⟩ ⟹ Z ⊆ W ⟹ W ⊆ V ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝⇩β ⟨l', W'⟩ ∧ Z' ⊆ W'"
proof (goal_cases)
case 1
then obtain Z'' where *: "A ⊢ ⟨l, Z⟩ ↝ ⟨l',Z''⟩" "Z' = Approx⇩β Z''" by auto
from alpha_interp.step_z_mono[OF this(1) 1(2)] obtain W' where
"A ⊢ ⟨l, W⟩ ↝ ⟨l',W'⟩" "Z'' ⊆ W'"
by auto
moreover with *(2) apx_mono[OF alpha_interp.step_z_V] ‹W ⊆ V› have
"Z' ⊆ Approx⇩β W'"
by metis
ultimately show ?case by blast
qed
lemma steps_z_beta_V: "A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ Z ⊆ V ⟹ Z' ⊆ V"
proof (induction rule: steps_z_beta.induct)
case refl then show ?case by blast
next
case (step A l Z l' Z' l'' Z'')
then obtain Z''' where "A ⊢ ⟨l', Z'⟩ ↝ ⟨l'',Z'''⟩" "Z'' = Approx⇩β Z'''" by auto
with alpha_interp.step_z_V[OF this(1)] apx_V step(3,4) show "Z'' ⊆ V" by auto
qed
lemma steps_z_beta_mono:
"A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l', Z'⟩ ⟹ Z ⊆ W ⟹ W ⊆ V ⟹ ∃ W'. A ⊢ ⟨l, W⟩ ↝⇩β* ⟨l', W'⟩ ∧ Z' ⊆ W'"
proof (induction rule: steps_z_beta.induct)
case refl then show ?case by auto
next
case (step A l Z l' Z' l'' Z'')
then obtain W' where "A ⊢ ⟨l, W⟩ ↝⇩β* ⟨l',W'⟩" "Z' ⊆ W'" by auto
with step_z_beta_mono[OF step(2) this(2) steps_z_beta_V[OF this(1) step(5)]] show ?case by blast
qed
lemma steps_z_beta_alt:
"A ⊢ ⟨l, Z⟩ ↝⇩β ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝⇩β* ⟨l'', Z''⟩ ⟹ A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l'', Z''⟩"
by (rotate_tac, induction rule: steps_z_beta.induct) blast+
lemma steps_z_beta_complete:
"A ⊢ ⟨l, Z⟩ ↝* ⟨l', Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l',Z''⟩ ∧ Z' ⊆ Z''"
proof (induction rule: steps_z.induct)
case refl with apx_empty_iff show ?case by blast
next
case (step A l Z l' Z' l'' Z'')
with alpha_interp.step_z_V[OF this(1,5)] obtain Z''' where
"A ⊢ ⟨l', Z'⟩ ↝⇩β* ⟨l'',Z'''⟩" "Z'' ⊆ Z'''"
by blast
with steps_z_beta_mono[OF this(1) beta_interp.apx_subset apx_V[OF alpha_interp.step_z_V[OF step(1,5)]]]
obtain W' where "A ⊢ ⟨l', Approx⇩β Z'⟩ ↝⇩β* ⟨l'', W'⟩" " Z'' ⊆ W'" by auto
moreover with step(1) have "A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l'',W'⟩" by (auto intro: steps_z_beta_alt)
ultimately show ?case by auto
qed
lemma steps_z_beta_complete':
"A ⊢ ⟨l, Z⟩ ↝* ⟨l',Z'⟩ ⟹ valid_abstraction A X k ⟹ Z ⊆ V ⟹ Z' ≠ {}
⟹ ∃ Z''. A ⊢ ⟨l, Z⟩ ↝⇩β* ⟨l',Z''⟩ ∧ Z'' ≠ {}"
using steps_z_beta_complete by fast
end
end
Theory Normalized_Zone_Semantics
chapter ‹Forward Analysis with DBMs and Widening›
theory Normalized_Zone_Semantics
imports DBM_Zone_Semantics Approx_Beta
begin
section ‹DBM-based Semantics with Normalization›
subsection ‹Single Step›
inductive step_z_norm ::
"('a, 'c, t, 's) ta ⇒ 's ⇒ t DBM ⇒ (nat ⇒ nat) ⇒ ('c ⇒ nat) ⇒ nat ⇒ 's ⇒ t DBM ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇘_,_,_⇙ ⟨_, _⟩" [61,61,61,61,61] 61)
where step_z_norm:
"A ⊢ ⟨l,D⟩ ↝⇘v,n⇙ ⟨l', D'⟩ ⟹ A ⊢ ⟨l,D⟩ ↝⇘k,v,n⇙ ⟨l', norm (FW D' n) k n⟩"
inductive steps_z_norm ::
"('a, 'c, t, 's) ta ⇒ 's ⇒ t DBM ⇒ (nat ⇒ nat) ⇒ ('c ⇒ nat) ⇒ nat ⇒ 's ⇒ t DBM ⇒ bool"
("_ ⊢ ⟨_, _⟩ ↝⇘_,_,_⇙* ⟨_, _⟩" [61,61,61,61,61] 61)
where
refl: "A ⊢ ⟨l, Z⟩ ↝⇘k,v,n⇙* ⟨l, Z⟩" |
step: "A ⊢ ⟨l, Z⟩ ↝⇘k,v,n⇙* ⟨l', Z'⟩ ⟹ A ⊢ ⟨l', Z'⟩ ↝⇘k,v,n⇙ ⟨l'', Z''⟩
⟹ A ⊢ ⟨l, Z⟩ ↝⇘k,v,n⇙* ⟨l'', Z''⟩"
context Regions
begin
abbreviation "v' ≡ beta_interp.v'"
abbreviation step_z_norm' ("_ ⊢ ⟨_, _⟩ ↝⇩𝒩 ⟨_, _⟩" [61,61,61] 61)
where
"A ⊢ ⟨l, D⟩ ↝⇩𝒩 ⟨l', D'⟩ ≡ A ⊢ ⟨l, D⟩ ↝⇘(k o v'),v,n⇙ ⟨l', D'⟩"
abbreviation steps_z_norm' ("_ ⊢ ⟨_, _⟩ ↝⇩𝒩* ⟨_, _⟩" [61,61,61] 61)
where
"A ⊢ ⟨l, D⟩ ↝⇩𝒩* ⟨l', D'⟩ ≡ A ⊢ ⟨l, D⟩ ↝⇘(k o v'),v,n⇙* ⟨l', D'⟩"
inductive_cases[elim!]: "A ⊢ ⟨l, u⟩ ↝⇩𝒩 ⟨l',u'⟩"
declare step_z_norm.intros[intro]
lemma apx_empty_iff'':
assumes "canonical M1 n" "[M1]⇘v,n⇙ ⊆ V" "dbm_int M1 n"
shows "[M1]⇘v,n⇙ = {} ⟷ [norm M1 (k o v') n]⇘v,n⇙ = {}"
using beta_interp.apx_norm_eq[OF assms] apx_empty_iff'[of "[M1]⇘v,n⇙"] assms unfolding V'_def by blast
inductive valid_dbm where
"[M]⇘v,n⇙ ⊆ V ⟹ dbm_int M n ⟹ valid_dbm M"
inductive_cases valid_dbm_cases[elim]: "valid_dbm M"
declare valid_dbm.intros[intro]
lemma step_z_valid_dbm:
assumes "A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l', D'⟩"
and "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
shows "valid_dbm D'"
proof -
from alpha_interp.step_z_V step_z_dbm_sound[OF assms(1,2)] step_z_dbm_preserves_int[OF assms(1,2)]
assms(3,4)
have
"dbm_int D' n" "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l', [D']⇘v,n⇙⟩"
by fastforce+
with alpha_interp.step_z_V[OF this(2)] assms(4) show ?thesis by auto
qed
lemma FW_zone_equiv_spec:
shows "[M]⇘v,n⇙ = [FW M n]⇘v,n⇙"
apply (rule FW_zone_equiv) using clock_numbering(2) by auto
lemma cn_weak: "∀k≤n. 0 < k ⟶ (∃c. v c = k)" using clock_numbering(2) by blast
lemma valid_dbm_non_empty_diag:
assumes "valid_dbm M" "[M]⇘v,n⇙ ≠ {}"
shows "∀ k ≤ n. M k k ≥ 𝟭"
proof safe
fix k assume k: "k ≤ n"
have "∀k≤n. 0 < k ⟶ (∃c. v c = k)" using clock_numbering(2) by blast
from k not_empty_cyc_free[OF this assms(2)] show "𝟭 ≤ M k k" by (simp add: cyc_free_diag_dest')
qed
lemma non_empty_cycle_free:
assumes "[M]⇘v,n⇙ ≠ {}"
shows "cycle_free M n"
by (meson assms clock_numbering(2) neg_cycle_empty negative_cycle_dest_diag)
lemma norm_empty_diag_preservation:
assumes "i ≤ n"
assumes "M i i < Le 0"
shows "norm M (k o v') n i i < Le 0"
proof -
have "¬ Le (k (v' i)) ≺ Le 0" by auto
with assms show ?thesis unfolding norm_def by (auto simp: Let_def less)
qed
lemma norm_FW_empty:
assumes "valid_dbm M"
assumes "[M]⇘v,n⇙ = {}"
shows "[norm (FW M n) (k o v') n]⇘v,n⇙ = {}" (is "[?M]⇘v,n⇙ = {}")
proof -
from assms(2) cyc_free_not_empty clock_numbering(1) cycle_free_diag_equiv have "¬ cycle_free M n"
by metis
from FW_neg_cycle_detect[OF this] obtain i where i: "i ≤ n" "FW M n i i < 𝟭" by auto
with norm_empty_diag_preservation[folded neutral] have "?M i i < 𝟭" .
with ‹i ≤ n› show ?thesis using beta_interp.neg_diag_empty_spec by auto
qed
lemma apx_norm_eq_spec:
assumes "valid_dbm M"
and "[M]⇘v,n⇙ ≠ {}"
shows "beta_interp.Approx⇩β ([M]⇘v,n⇙) = [norm (FW M n) (k o v') n]⇘v,n⇙"
proof -
note cyc_free = non_empty_cycle_free[OF assms(2)]
from assms(1) FW_zone_equiv_spec[of M] have "[M]⇘v,n⇙ = [FW M n]⇘v,n⇙" by (auto simp: neutral)
with beta_interp.apx_norm_eq[OF fw_canonical[OF cyc_free] _ FW_int_preservation]
valid_dbm_non_empty_diag[OF assms(1,2)] assms(1)
show "Approx⇩β ([M]⇘v,n⇙) = [norm (FW M n) (k o v') n]⇘v,n⇙" by auto
qed
print_statement step_z_norm.inducts
lemma step_z_norm_induct[case_names _ step_z_norm step_z_refl]:
assumes "x1 ⊢ ⟨x2, x3⟩ ↝⇘(k o v'),v,n⇙ ⟨x7,x8⟩"
and step_z_norm:
"⋀A l D l' D'.
A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l',D'⟩ ⟹
P A l D l' (norm (FW D' n) (k o v') n)"
shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: step_z_norm.inducts) auto
lemma FW_valid_preservation:
assumes "valid_dbm M"
shows "valid_dbm (FW M n)"
proof standard
from FW_int_preservation assms show "dbm_int (FW M n) n" by blast
next
from FW_zone_equiv_spec[of M, folded neutral] assms show "[FW M n]⇘v,n⇙ ⊆ V" by fastforce
qed
text ‹Obsolete›
lemma norm_diag_preservation:
assumes "∀l≤n. M1 l l ≤ 𝟭"
shows "∀l≤n. (norm M1 (k o v') n) l l ≤ 𝟭" (is "∀ l ≤ n. ?M l l ≤ 𝟭")
proof safe
fix j assume j: "j ≤ n"
show "?M j j ≤ 𝟭"
proof (cases "j = 0")
case True
with j assms show ?thesis unfolding norm_def neutral less_eq dbm_le_def by auto
next
case False
have *: "real ((k ∘ v') j) ≥ 0" by auto
from j assms have **: "M1 j j ≤ Le 0" unfolding neutral by auto
have "norm_upper (M1 j j) (real ((k ∘ v') j)) = M1 j j"
using * ** apply (cases "M1 j j") apply auto by fastforce+
with assms(1) j False have
"?M j j = norm_lower (M1 j j) (- real ((k ∘ v') j))"
unfolding norm_def by auto
with ** show ?thesis unfolding neutral by auto
qed
qed
lemma norm_FW_valid_preservation_non_empty:
assumes "valid_dbm M" "[M]⇘v,n⇙ ≠ {}"
shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
show ?thesis
proof standard
from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
next
from fw_canonical[OF non_empty_cycle_free] assms have "canonical (FW M n) n" by auto
from beta_interp.norm_V_preservation[OF _ this ] valid show "[?M]⇘v,n⇙ ⊆ V" by fast
qed
qed
lemma norm_FW_valid_preservation_empty:
assumes "valid_dbm M" "[M]⇘v,n⇙ = {}"
shows "valid_dbm (norm (FW M n) (k o v') n)" (is "valid_dbm ?M")
proof -
from FW_valid_preservation[OF assms(1)] have valid: "valid_dbm (FW M n)" .
show ?thesis
proof standard
from valid beta_interp.norm_int_preservation show "dbm_int ?M n" by blast
next
from norm_FW_empty[OF assms(1,2)] show "[?M]⇘v,n⇙ ⊆ V" by fast
qed
qed
lemma norm_FW_valid_preservation:
assumes "valid_dbm M"
shows "valid_dbm (norm (FW M n) (k o v') n)"
using assms norm_FW_valid_preservation_empty norm_FW_valid_preservation_non_empty by metis
lemma norm_beta_sound:
assumes "A ⊢ ⟨l,D⟩ ↝⇩𝒩 ⟨l',D'⟩" "global_clock_numbering A v n" "valid_abstraction A X k"
and "valid_dbm D"
shows "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝⇩β ⟨l',[D']⇘v,n⇙⟩" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
case (step_z_norm A l D l' D')
from step_z_dbm_sound[OF step_z_norm(1,2)] have "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝ ⟨l',[D']⇘v,n⇙⟩" by blast
then have *: "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝⇩β ⟨l',Approx⇩β ([D']⇘v,n⇙)⟩" by force
show ?case
proof (cases "[D']⇘v,n⇙ = {}")
case False
from apx_norm_eq_spec[OF step_z_valid_dbm[OF step_z_norm] False] *
show ?thesis by auto
next
case True
with norm_FW_empty[OF step_z_valid_dbm[OF step_z_norm] this] beta_interp.apx_empty *
show ?thesis by auto
qed
qed
lemma step_z_norm_valid_dbm:
assumes "A ⊢ ⟨l, D⟩ ↝⇩𝒩 ⟨l',D'⟩" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
shows "valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: step_z_norm_induct, intro assms(1))
case (step_z_norm A l D l' D')
with norm_FW_valid_preservation[OF step_z_valid_dbm[OF step_z_norm]] show ?case by fast
qed
lemma norm_beta_complete:
assumes "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝⇩β ⟨l',Z⟩" "global_clock_numbering A v n" "valid_abstraction A X k"
and "valid_dbm D"
obtains D' where "A ⊢ ⟨l,D⟩ ↝⇩𝒩 ⟨l',D'⟩" "[D']⇘v,n⇙ = Z" "valid_dbm D'"
proof -
from assms(1) obtain Z' where Z': "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝ ⟨l',Z'⟩" "Z = Approx⇩β Z'" by auto
from assms(4) have "dbm_int D n" by auto
with step_z_dbm_DBM[OF Z'(1) assms(2)] step_z_dbm_preserves_int[OF _ assms(2,3)] obtain D' where
D': "A ⊢ ⟨l, D⟩ ↝⇘v,n⇙ ⟨l',D'⟩" "Z' = [D']⇘v,n⇙" "dbm_int D' n"
by auto
note valid_D' = step_z_valid_dbm[OF D'(1) assms(2,3)]
obtain D'' where D'': "D'' = norm (FW D' n) (k ∘ v') n" by auto
show ?thesis
proof (cases "Z' = {}")
case False
with D' have *: "[D']⇘v,n⇙ ≠ {}" by auto
from apx_norm_eq_spec[OF valid_D' this] D'' D'(2) Z'(2) assms(4) have "Z = [D'']⇘v,n⇙" by auto
with norm_FW_valid_preservation[OF valid_D'] D' D'' * that[of D''] assms(4)
show thesis by blast
next
case True
with norm_FW_empty[OF valid_D'[OF assms(4)]] D'' D' Z'(2)
norm_FW_valid_preservation[OF valid_D'[OF assms(4)]] beta_interp.apx_empty
show thesis
apply -
apply (rule that[of D''])
apply blast
by fastforce+
qed
qed
subsection ‹Multi step›
declare steps_z_norm.intros[intro]
lemma steps_z_norm_induct[case_names _ refl step]:
assumes "x1 ⊢ ⟨x2, x3⟩ ↝⇘(k o v'),v,n⇙* ⟨x7,x8⟩"
and "⋀A l Z. P A l Z l Z"
and
"⋀A l Z l' Z' l'' Z''.
A ⊢ ⟨l, Z⟩ ↝⇘(k o v'),v,n⇙* ⟨l',Z'⟩ ⟹
P A l Z l' Z' ⟹
A ⊢ ⟨l', Z'⟩ ↝⇘(k o v'),v,n⇙ ⟨l'',Z''⟩ ⟹ P A l Z l'' Z''"
shows "P x1 x2 x3 x7 x8"
using assms by (induction rule: steps_z_norm.induct) auto
lemma norm_beta_sound_multi:
assumes "A ⊢ ⟨l,D⟩ ↝⇩𝒩* ⟨l',D'⟩" "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
shows "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝⇩β* ⟨l',[D']⇘v,n⇙⟩ ∧ valid_dbm D'" using assms(2-)
proof (induction A l D l' D' rule: steps_z_norm_induct, intro assms(1))
case refl then show ?case by fast
next
case (step A l Z l' Z' l'' Z'')
then have "A ⊢ ⟨l, [Z]⇘v,n⇙⟩ ↝⇩β* ⟨l',[Z']⇘v,n⇙⟩" "valid_dbm Z'" by fast+
with norm_beta_sound[OF step(2,4,5)] step_z_norm_valid_dbm[OF step(2,4,5)] show ?case by force
qed
lemma norm_beta_complete_multi:
assumes "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝⇩β* ⟨l',Z⟩" "global_clock_numbering A v n" "valid_abstraction A X k"
and "valid_dbm D"
obtains D' where "A ⊢ ⟨l,D⟩ ↝⇩𝒩* ⟨l',D'⟩" "[D']⇘v,n⇙ = Z" "valid_dbm D'"
using assms
proof (induction A l "[D]⇘v,n⇙" l' Z arbitrary: thesis rule: steps_z_beta.induct)
case refl
from this(1)[OF steps_z_norm.refl] this(4) show thesis by fast
next
case (step A l l' Z' l'' Z'')
from step(2)[OF _ step(5,6,7)] obtain D' where D':
"A ⊢ ⟨l, D⟩ ↝⇩𝒩* ⟨l',D'⟩" "[D']⇘v,n⇙ = Z'" "valid_dbm D'"
.
with norm_beta_complete[OF _ step(5,6), of l' D' l'' Z''] step(3) obtain D'' where D'':
"A ⊢ ⟨l', D'⟩ ↝⇩𝒩 ⟨l'',D''⟩" "[D'']⇘v,n⇙ = Z''" "valid_dbm D''"
by auto
with D'(1) step(4)[of D''] show thesis by blast
qed
lemma norm_beta_equiv_multi:
assumes "global_clock_numbering A v n" "valid_abstraction A X k"
and "valid_dbm D"
shows "(∃ D'. A ⊢ ⟨l,D⟩ ↝⇩𝒩* ⟨l',D'⟩ ∧ Z = [D']⇘v,n⇙) ⟷ A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝⇩β* ⟨l',Z⟩"
using norm_beta_complete_multi[OF _ assms] norm_beta_sound_multi[OF _ assms] by metis
subsection ‹Connecting with Correctness Results for Approximating Semantics›
lemma steps_z_norm_complete':
assumes "A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝* ⟨l',Z⟩" "global_clock_numbering A v n" "valid_abstraction A X k"
and "valid_dbm D"
shows "∃ D'. A ⊢ ⟨l, D⟩ ↝⇩𝒩* ⟨l',D'⟩ ∧ Z ⊆ [D']⇘v,n⇙"
proof -
from steps_z_beta_complete[OF assms(1,3)] assms(4) obtain Z'' where Z'':
"A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝⇩β* ⟨l',Z''⟩" "Z ⊆ Z''"
by auto
from this(2) norm_beta_complete_multi[OF this(1) assms(2,3,4)] show ?thesis by metis
qed
lemma valid_dbm_V':
assumes "valid_dbm M"
shows "[M]⇘v,n⇙ ∈ V'"
using assms unfolding V'_def by force
lemma steps_z_norm_sound':
assumes "A ⊢ ⟨l,D⟩ ↝⇩𝒩* ⟨l',D'⟩"
and "global_clock_numbering A v n"
and "valid_abstraction A X k"
and "valid_dbm D"
and "[D']⇘v,n⇙ ≠ {}"
shows "∃Z. A ⊢ ⟨l,[D]⇘v,n⇙⟩ ↝* ⟨l',Z⟩ ∧ Z ≠ {}"
proof -
from norm_beta_sound_multi[OF assms(1-4)] have "A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝⇩β* ⟨l',[D']⇘v,n⇙⟩" by fast
from steps_z_beta_sound[OF this _ assms(3) valid_dbm_V'] assms(2,4,5) show ?thesis by blast
qed
section ‹The Final Result About Language Emptiness›
lemma steps_z_norm_complete:
assumes "A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩" "u ∈ [D]⇘v,n⇙"
and "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
shows "∃ D'. A ⊢ ⟨l, D⟩ ↝⇩𝒩* ⟨l',D'⟩ ∧ u' ∈ [D']⇘v,n⇙"
using steps_z_norm_complete'[OF _ assms(3-)] steps_z_complete[OF assms(1,2)] by fast
lemma steps_z_norm_sound:
assumes "A ⊢ ⟨l,D⟩ ↝⇩𝒩* ⟨l',D'⟩"
and "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
and "[D']⇘v,n⇙ ≠ {}"
shows "∃ u ∈ [D]⇘v,n⇙. ∃ u'. A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩"
using steps_z_norm_sound'[OF assms] steps_z_sound by fast
theorem steps_z_norm_decides_emptiness:
assumes "global_clock_numbering A v n" "valid_abstraction A X k" "valid_dbm D"
shows "(∃ D'. A ⊢ ⟨l, D⟩ ↝⇩𝒩* ⟨l',D'⟩ ∧ [D']⇘v,n⇙ ≠ {})
⟷ (∃ u ∈ [D]⇘v,n⇙. ∃ u'. A ⊢ ⟨l, u⟩ →* ⟨l', u'⟩)"
using steps_z_norm_sound[OF _ assms] steps_z_norm_complete[OF _ _ assms] by fast
section ‹Finiteness of the Search Space›
abbreviation "dbm_default M ≡ (∀ i > n. ∀ j. M i j = 𝟭) ∧ (∀ j > n. ∀ i. M i j = 𝟭)"
lemma "a ∈ ℤ ⟹ ∃ b. a = real_of_int b" using Ints_cases by auto
lemma norm_default_preservation:
"dbm_default M ⟹ dbm_default (norm M (k o v') n)"
by (simp add: norm_def)
lemma normalized_integral_dbms_finite:
"finite {norm M (k o v') n | M. dbm_int M n ∧ dbm_default M}"
proof -
let ?u = "Max {(k o v') i | i. i ≤ n}" let ?l = "- ?u"
let ?S = "(Le ` {d :: int. ?l ≤ d ∧ d ≤ ?u}) ∪ (Lt ` {d :: int. ?l ≤ d ∧ d ≤ ?u}) ∪ {∞}"
from finite_set_of_finite_funs2[of "{0..n}" "{0..n}" ?S] have fin:
"finite {f. ∀x y. (x ∈ {0..n} ∧ y ∈ {0..n} ⟶ f x y ∈ ?S)
∧ (x ∉ {0..n} ⟶ f x y = 𝟭) ∧ (y ∉ {0..n} ⟶ f x y = 𝟭)}" (is "finite ?R")
by auto
{ fix M :: "t DBM" assume A: "dbm_int M n" "dbm_default M"
let ?M = "norm M (k o v') n"
from beta_interp.norm_int_preservation[OF A(1)] norm_default_preservation[OF A(2)] have
A: "dbm_int ?M n" "dbm_default ?M"
by blast+
{ fix i j assume "i ∈ {0..n}" "j ∈ {0..n}"
then have B: "i ≤ n" "j ≤ n" by auto
have "?M i j ∈ ?S"
proof (cases "?M i j = ∞")
case True then show ?thesis by auto
next
case False
note not_inf = this
with B A(1) have "get_const (?M i j) ∈ ℤ" by auto
moreover have "?l ≤ get_const (?M i j) ∧ get_const (?M i j) ≤ ?u"
proof (cases "i = 0")
case True
show ?thesis
proof (cases "j = 0")
case True
with ‹i = 0› A(1) B have
"?M i j = norm_lower (norm_upper (M 0 0) 0) 0"
unfolding norm_def by auto
also have "… ≠ ∞ ⟶ get_const … = 0" by (cases "M 0 0"; fastforce)
finally show ?thesis using not_inf by auto
next
case False
with ‹i = 0› B not_inf have "?M i j ≤ Le 0" "Lt (-real (k (v' j))) ≤ ?M i j"
by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
with not_inf have "get_const (?M i j) ≤ 0" "-k (v' j) ≤ get_const (?M i j)"
by (cases "?M i j"; auto)+
moreover from ‹j ≤ n› have "- (k o v') j ≥ ?l" by (auto intro: Max_ge)
ultimately show ?thesis by auto
qed
next
case False
then have "i > 0" by simp
show ?thesis
proof (cases "j = 0")
case True
with ‹i > 0› A(1) B not_inf have "Lt 0 ≤ ?M i j" "?M i j ≤ Le (real ((k ∘ v') i))"
by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
with not_inf have "0 ≤ get_const (?M i j)" "get_const (?M i j) ≤ k (v' i)"
by (cases "?M i j"; auto)+
moreover from ‹i ≤ n› have "(k o v') i ≤ ?u" by (auto intro: Max_ge)
ultimately show ?thesis by auto
next
case False
with ‹i > 0› A(1) B not_inf have
"Lt (-real ((k ∘ v') j)) ≤ ?M i j" "?M i j ≤ Le (real ((k ∘ v') i))"
by (unfold norm_def, auto simp: Let_def, unfold less[symmetric], auto)
with not_inf have "- k (v' j) ≤ get_const (?M i j)" "get_const (?M i j) ≤ k (v' i)"
by (cases "?M i j"; auto)+
moreover from ‹i ≤ n› ‹j ≤ n› have "(k o v') i ≤ ?u" "(k o v') j ≤ ?u" by (auto intro: Max_ge)
ultimately show ?thesis by auto
qed
qed
ultimately show ?thesis by (cases "?M i j"; auto elim: Ints_cases)
qed
} moreover
{ fix i j assume "i ∉ {0..n}"
with A(2) have "?M i j = 𝟭" by auto
} moreover
{ fix i j assume "j ∉ {0..n}"
with A(2) have "?M i j = 𝟭" by auto
} moreover note the = calculation
} then have "{norm M (k o v') n | M. dbm_int M n ∧ dbm_default M} ⊆ ?R" by blast
with fin show ?thesis by (blast intro: finite_subset)
qed
end
section ‹Appendix: Standard Clock Numberings for Concrete Models›
locale Regions' =
fixes X and k :: "'c ⇒ nat" and v :: "'c ⇒ nat" and n :: nat and not_in_X
assumes finite: "finite X"
assumes clock_numbering': "∀ c ∈ X. v c > 0" "∀ c. c ∉ X ⟶ v c > n"
assumes bij: "bij_betw v X {1..n}"
assumes non_empty: "X ≠ {}"
assumes not_in_X: "not_in_X ∉ X"
begin
lemma inj: "inj_on v X" using bij_betw_imp_inj_on bij by simp
lemma cn_weak: "∀ c. v c > 0" using clock_numbering' by force
lemma in_X: assumes "v x ≤ n" shows "x ∈ X" using assms clock_numbering'(2) by force
end
sublocale Regions' ⊆ Regions
proof (unfold_locales, auto simp: finite clock_numbering' non_empty cn_weak not_in_X, goal_cases)
case (1 x y) with inj in_X show ?case unfolding inj_on_def by auto
next
case (2 k)
from bij have "v ` X = {1..n}" unfolding bij_betw_def by auto
from 2 have "k ∈ {1..n}" by simp
then obtain x where "x ∈ X" "v x = k" unfolding image_def
by (metis (no_types, lifting) ‹v ` X = {1..n}› imageE)
then show ?case by blast
next
case (3 x) with bij show ?case unfolding bij_betw_def by auto
qed
lemma standard_abstraction:
assumes "finite (clkp_set A)" "finite (collect_clkvt (trans_of A))" "∀(_,m::real) ∈ clkp_set A. m ∈ ℕ"
obtains k :: "'c ⇒ nat" where "valid_abstraction A (clk_set A) k"
proof -
from assms have 1: "finite (clk_set A)" by auto
have 2: "collect_clkvt (trans_of A) ⊆ clk_set A" by auto
from assms obtain L where L: "distinct L" "set L = clkp_set A" by (meson finite_distinct_list)
let ?M = "λ c. {m . (c, m) ∈ clkp_set A}"
let ?X = "clk_set A"
let ?m = "map_of L"
let ?k = "λ x. if ?M x = {} then 0 else nat (floor (Max (?M x)) + 1)"
{ fix c m assume A: "(c, m) ∈ clkp_set A"
from assms(1) have "finite (snd ` clkp_set A)" by auto
moreover have "?M c ⊆ (snd ` clkp_set A)" by force
ultimately have fin: "finite (?M c)" by (blast intro: finite_subset)
then have "Max (?M c) ∈ {m . (c, m) ∈ clkp_set A}" using Max_in A by auto
with assms(3) have "Max (?M c) ∈ ℕ" by auto
then have "floor (Max (?M c)) = Max (?M c)" by (metis Nats_cases floor_of_nat of_int_of_nat_eq)
with A have *: "?k c = Max (?M c) + 1"
proof auto
fix n :: int and x :: real
assume "Max {m. (c, m) ∈ clkp_set A} = real_of_int n"
then have "real_of_int (n + 1) ∈ ℕ"
using ‹Max {m. (c, m) ∈ clkp_set A} ∈ ℕ› by auto
then show "real (nat (n + 1)) = real_of_int n + 1"
by (metis Nats_cases ceiling_of_int nat_int of_int_1 of_int_add of_int_of_nat_eq)
qed
from fin A have "Max (?M c) ≥ m" by auto
moreover from A assms(3) have "m ∈ ℕ" by auto
ultimately have "m ≤ ?k c" "m ∈ ℕ" "c ∈ clk_set A" using A * by force+
}
then have "∀(x, m)∈clkp_set A. m ≤ ?k x ∧ x ∈ clk_set A ∧ m ∈ ℕ" by blast
with 1 2 have "valid_abstraction A ?X ?k" by - (standard, assumption+)
then show thesis ..
qed
definition
"finite_ta A ≡ finite (clkp_set A) ∧ finite (collect_clkvt (trans_of A))
∧ (∀(_,m::real) ∈ clkp_set A. m ∈ ℕ) ∧ clk_set A ≠ {} ∧ -clk_set A ≠ {}"
lemma finite_ta_Regions':
fixes A :: "('a, 'c, real, 's) ta"
assumes "finite_ta A"
obtains v n x where "Regions' (clk_set A) v n x"
proof -
from assms obtain x where x: "x ∉ clk_set A" unfolding finite_ta_def by auto
from assms(1) have "finite (clk_set A)" unfolding finite_ta_def by auto
with standard_numbering[of "clk_set A"] assms obtain v and n :: nat where
"bij_betw v (clk_set A) {1..n}"
"∀c∈clk_set A. 0 < v c" "∀c. c ∉ clk_set A ⟶ n < v c"
by auto
then have "Regions' (clk_set A) v n x" using x assms unfolding finite_ta_def by - (standard, auto)
then show ?thesis ..
qed
lemma finite_ta_RegionsD:
assumes "finite_ta A"
obtains k :: "'b ⇒ nat" and v n x where
"Regions' (clk_set A) v n x" "valid_abstraction A (clk_set A) k" "global_clock_numbering A v n"
proof -
from standard_abstraction assms obtain k :: "'b ⇒ nat" where k:
"valid_abstraction A (clk_set A) k"
unfolding finite_ta_def by blast
from finite_ta_Regions'[OF assms] obtain v n x where *: "Regions' (clk_set A) v n x" .
then interpret interp: Regions' "clk_set A" k v n x .
from interp.clock_numbering have "global_clock_numbering A v n" by blast
with * k show ?thesis ..
qed
definition valid_dbm where "valid_dbm M n ≡ dbm_int M n ∧ (∀ i ≤ n. M 0 i ≤ 𝟭)"
lemma dbm_positive:
assumes "M 0 (v c) ≤ 𝟭" "v c ≤ n" "DBM_val_bounded v u M n"
shows "u c ≥ 0"
proof -
from assms have "dbm_entry_val u None (Some c) (M 0 (v c))" unfolding DBM_val_bounded_def by auto
with assms(1) show ?thesis
proof (cases "M 0 (v c)", goal_cases)
case 1
then show ?case unfolding less_eq neutral using order_trans by (fastforce dest!: le_dbm_le)
next
case 2
then show ?case unfolding less_eq neutral
by (auto dest!: lt_dbm_le) (meson less_trans neg_0_less_iff_less not_less)
next
case 3
then show ?case unfolding neutral less_eq dbm_le_def by auto
qed
qed
lemma valid_dbm_pos:
assumes "valid_dbm M n"
shows "[M]⇘v,n⇙ ⊆ {u. ∀ c. v c ≤ n ⟶ u c ≥ 0}"
using dbm_positive assms unfolding valid_dbm_def unfolding DBM_zone_repr_def by fast
lemma (in Regions') V_alt_def:
shows "{u. ∀ c. v c > 0 ∧ v c ≤ n ⟶ u c ≥ 0} = V"
unfolding V_def using clock_numbering by metis
text ‹
An example of obtaining concrete models from our formalizations.
›
lemma steps_z_norm_sound_spec:
assumes "finite_ta A"
obtains k v n where
"A ⊢ ⟨l,D⟩ ↝⇘k,v,n⇙* ⟨l',D'⟩ ∧ valid_dbm D n ∧ [D']⇘v,n⇙ ≠ {}
⟶ (∃Z. A ⊢ ⟨l, [D]⇘v,n⇙⟩ ↝* ⟨l',Z⟩ ∧ Z ≠ {})"
proof -
from finite_ta_RegionsD[OF assms(1)] obtain k :: "'b ⇒ nat" and v n x where *:
"Regions' (clk_set A) v n x" "valid_abstraction A (clk_set A) k" "global_clock_numbering A v n"
.
from this(1) interpret interp: Regions' "clk_set A" k v n x .
define v' where "v' i = (if i ≤ n then (THE c. c ∈ clk_set A ∧ v c = i) else x)" for i
{ fix l D l' D'
assume step: "A ⊢ ⟨l,D⟩ ↝⇘(k o v'),v,n⇙* ⟨l',D'⟩"
and valid: "valid_dbm D n" and non_empty: "[D']⇘v,n⇙ ≠ {}"
from valid_dbm_pos[OF valid] interp.V_alt_def have "[D]⇘v,n⇙ ⊆ interp.V" by blast
with valid have valid: "interp.valid_dbm D" unfolding valid_dbm_def by auto
from step have "interp.steps_z_norm' A l D l' D'" unfolding v'_def interp.beta_interp.v'_def .
note this = interp.steps_z_norm_sound'[OF this *(3,2) valid non_empty]
}
then show thesis by (blast intro: that)
qed
end